改进VBA来检查列中的数据

我试图执行额外的代码检查数据是否有效。 如果不是，则复制到当前工作簿的数据将被省略。

无效的数据是在-0.01到0.01之间的任何地方

Sub TransferTRA015() Dim strPath2 As String Dim strPath3 As String Dim strPath4 As String Dim wbkWorkbook1 As Workbook Dim wbkWorkbook2 As Workbook Dim wbkWorkbook3 As Workbook Dim wbkWorkbook4 As Workbook strPath2 = "C:\Users\transducer1.CCS\Desktop\LabVIEW Data\TRA015\TRA015_TEST_Room.xlsx" strPath3 = "C:\Users\transducer1.CCS\Desktop\LabVIEW Data\TRA015\TRA015_TEST_Cold.xlsx" strPath4 = "C:\Users\transducer1.CCS\Desktop\LabVIEW Data\TRA015\TRA015_TEST_Hot.xlsx" Set wbkWorkbook1 = ThisWorkbook '### changed this Set wbkWorkbook2 = Workbooks.Open(strPath2) Set wbkWorkbook3 = Workbooks.Open(strPath3) Set wbkWorkbook4 = Workbooks.Open(strPath4) 'copy the values across '### change the sheet and range to what you need wbkWorkbook1.Worksheets("RAW DATA").Range("A13:Y36").Value = _ wbkWorkbook2.Worksheets("sheet1").Range("A2:Y25").Value wbkWorkbook1.Worksheets("RAW DATA").Range("A5:Y8").Value = _ wbkWorkbook4.Worksheets("sheet1").Range("A2:Y5").Value wbkWorkbook1.Worksheets("RAW DATA").Range("A40:Y43").Value = _ wbkWorkbook3.Worksheets("sheet1").Range("A2:Y5").Value wbkWorkbook2.Close (True) wbkWorkbook3.Close (True) wbkWorkbook4.Close (True) End Sub 

Answer 1

你不能像这样复制数据，如果你select一个有很多单元格的范围，这个范围的值等于左上angular单元格的值。

将以下内容添加到您的代码中，以便以最快捷的方式将wbkWorkbook2.Worksheets（“sheet1”）中指定范围的值复制到wbkWorkbook1.Worksheets（“RAW DATA”）。

 Dim vSource as Variant Dim LastRow as long, arrayRow as long, arrayCol as long With wbkWorkbook2.Worksheets("sheet1") 'find last row with data in the sheet LastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row vSource = .Range("a2:y" & LastRow) 'or .Range("A2:Y25") if for example 'you only need this specified part of data For arrayRow = Lbound(vSource) to Ubound(vSource) For arrayCol = Lbound(vSource,2) to Ubound(vSource,2) If vSource(arrayRow,arrayCol)<0.01 and vSource(arrayRow,arrayCol)>-0.01 then vSource(arrayRow,arrayCol)=vbNullString End if Next arrayCol Next arrayRow End With wbkWorkbook1.Worksheets("RAW DATA").Range("A13:Y36") = vSource