VBA遍歷列並應用公式（如果匹配）（或不匹配）

Question

我正在嘗試創建一個動態電子表格（模板），它將用於頻繁獲取數據。在這個數據集中，我必須使用斜率/截距值來校正提取的數據。但是，如果數據爲0或無效，我想不進行任何計算。這也可以通過在不同的列中的給定值referrenced，讓說Sheet 1中列H，具有10

一個值K細胞在表「標籤」包含斜率&截距值，柱的「G 「工作表1」包含從服務器提取的數據。爲了簡單起見，讓它們都具有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和LastRow變量，意味着數據被附加到其中。

在此先感謝！

Answer 1

感謝@arcadeprecinct和@tan-stanley，我已經找到了可以接受的解決方案。 它複製原始代碼，但包含循環和條件檢查。但是我已經在包含設定值數據的偏移列上完成了它。如果設定值爲0或Null，則不會對現有值執行任何計算。

' 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 

Answer 2

另一個解決方法是，除了@arcadeprecinct註釋的是放置一個輸入框。例如，讓用戶鍵入要忽略的符號（例如：0 x X），以防萬一存在x，X或0時的任何組合。將用戶輸入分割並插入數組。

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 

希望它有幫助。