列内のデータをチェックするためにVBAを改善する

Question

データが有効かどうかをチェックする追加コードを実装しようとしています。そうでない場合、データは現在のワークブックにコピーされません。

無効なデータは、あなたがた細胞をたくさん持っている範囲を選択した場合、この範囲の値が値に等しく、このようにデータをコピーすることはできませんどこでも

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

0.01〜-0.01の間にあります左上のセルの

VBAが提供する最も簡単な方法で、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