VBA遍历列并应用公式(如果匹配)(或不匹配)

我正在尝试创build一个dynamic电子表格(模板),它将用于频繁获取数据。 在这个数据集中,我必须使用斜率/截距值来校正提取的数据。 但是, 如果数据是0或Null我不想进行任何计算 。 这也可以通过不同列中的设定值来引用,可以说Sheet1列H,值为10。

Sheet“ Tags ”中的K个单元格包含斜率和截距值,“ Sheet1 ”的G列包含从服务器拉取的数据。 为了简单起见,让他们都有10.0作为价值。 但是,G列中的数据可能因工艺条件而异。

目前我正在浏览带有数据的列,一旦匹配,就会在一定范围内对原始值进行乘法或加法运算,如下所示:

' Declare vars Dim FirstRow As Integer Dim LastRow As Integer Dim Number As Integer Dim fndStr As String Dim sht As Worksheet ' Init vars Set sht = ThisWorkbook.Worksheets("Sheet1") LineText = "" Number = 0 LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row ' Loop through colums till fndStr is found Do While Not fndStr = "lastWord" fndStr = Sheets("Sheet1").Range("A1").Offset(0, Number) Select Case fndStr Case Var1: Sheets("Tags").Range("K7").Copy Sheets("Sheet1").Range("G" & FirstRow & ":G" & LastRow).PasteSpecial xlPasteValues, xlPasteSpecialOperationMultiply Sheets("Tags").Range("K6").Copy Sheets("Sheet1").Range("G" & FirstRow & ":G" & LastRow).PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd Number = Number + 1 Case "lastWord": Exit Do Case Else: Number = Number + 1 End Select Loop 

一些额外的信息,当新的数据被拉,先前的或已经存在的数据,将不会被重新计算,因为这些是FirstRow和LastRowvariables意味着附加数据。

提前致谢!

另一个解决方法是,除了@arcadeprecinct的评论是放置一个input框。

例如,让用户input符号来忽略(例如:0 x X),任何组合,只要有x,X或0就可以。将用户input分割并插入到数组中。

  Dim userInput as String Dim allInputs as Variant userInput= InputBox("Key in notation to ignore.") allInputs = Split(Split(Trim(userInput), " ") 

再加上@arcadeprecinct的评论,根据数组做一个if else。

 for i = 1 to lastRow for x = 0 to Ubound(allInputs) 'do a check here next x next i 

希望能帮助到你。

感谢@arcadeprecinct和@tan-stanley,我一直能find一个可以接受的解决scheme。 它复制了原始代码,但包含循环和条件检查。 不过,我已经在包含设定值数据的偏移列上做了这个工作。 如果设定值为0Null会对现有值执行任何计算。

 ' Declare vars Dim Slope As Double Dim Intercept As Double Dim Number As Integer Dim cellValue As Range Dim dataRange As Range Dim FirstRow As Integer Dim LastRow As Integer Dim Number As Integer Dim fndStr As String Dim sht As Worksheet ' Init vars Set sht = ThisWorkbook.Worksheets("Sheet1") fndStr = "" Number = 0 LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row ' Loop through colums till fndStr is found Do While Not fndStr = "lastWord" fndStr = Sheets("Sheet1").Range("A1").Offset(0, Number) Select Case fndStr Case Var1: Slope = Sheets("Tags").Range("H7").Value Intercept = Sheets("Tags").Range("H6").Value Set dataRange = Sheets("R1").Range("G" & FirstRow & ":G" & LastRow) For Each cellValue In dataRange If cellValue.Offset(0, 1).Value <> 0 And cellValue.Offset(0, 1).Value <> "Null" Then cellValue.Value = cellValue.Value * Slope + Intercept End If Next cellValue Number = Number + 1 Case "lastWord": Exit Do Case Else: Number = Number + 1 End Select Loop