VBA根据条件

Question

我总共有3个名为wb1，wb2和wb3的工作簿。我已经编写了一个vba程序来将数据复制并粘贴到启用宏的工作簿中。我遇到的问题是改进复制和粘贴，使得如果wb1中B2：B25列中的数据介于-0.1到0.1之间，则下一个连续列C2：C25和原始B2：B25值不会被复制。复制和粘贴将继续，直到检查到AG的所有列

Simliarly，该程序还将复制和粘贴wb2＆amp; wb3基于以上标准。唯一的区别是粘贴位置分别为A5：AG8和A40：AG43。

实施例 在wb1：

A      B   C        D      F
0.09   1   0.0026   0      -0.17
800    2   0.00457  -0.05  -0.15
1600   3.1 0.00345  0.01   -0.1

程序会将所有数据从A列复制到C，但省略D＆amp; F到A13中的excel宏：AG36，它看起来像下面的结果。

A      B   C        
0.09   1   0.0026   
800    2   0.00457  
1600   3.1 0.00345 

这将继续下一个连续的列直到AG;如果G2：G25的所有值都在-0.1到0.1之间，则G和H都被省略。

下面的程序只是将数据复制并粘贴到excel宏工作簿而不使用任何过滤器。如何以实现上述更改的方式实现？

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

Application.ScreenUpdating = False


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)


'### change the sheet and range to what you need
wbkWorkbook1.Worksheets("RAW DATA").Range("A13:AG36").Value = _
    wbkWorkbook2.Worksheets("sheet1").Range("A2:AG25").Value


wbkWorkbook1.Worksheets("RAW DATA").Range("A5:AG8").Value = _
    wbkWorkbook4.Worksheets("sheet1").Range("A2:AG5").Value

wbkWorkbook1.Worksheets("RAW DATA").Range("A40:AG43").Value = _
    wbkWorkbook3.Worksheets("sheet1").Range("A2:AG5").Value


wbkWorkbook2.Close (True)
wbkWorkbook3.Close (True)
wbkWorkbook4.Close (True)

Application.ScreenUpdating = False

End Sub

Answer 1

以下两种方法可以使用 WorksheetFunctions 来测试某个范围是否符合您的条件。

VBA WorksheetFunction.Min和WorksheetFunction.Max

With wbkWorkbook1.Worksheets("RAW DATA")

    If WorksheetFunction.Min(.Range("B2:B25")) < -0.1 Or WorksheetFunction.Min(.Range("B2:B25")) < -0.1 Then

    End If

End With

Worksheet.Evaluate返回测试该工作表范围的公式的值。

If wbkWorkbook1.Worksheets("RAW DATA").Evaluate("OR(MIN(B2:B25)>=-0.1,MAX(B2:B25)<=0.1)") Then

End If