2017-08-02 89 views
0

在我的場景中,我有四列,列A-D。如果列B包含任何值,那麼列A中的匹配行必須更新以包含預定值。相同的宏被應用於列C和D.我已代碼右現在實現了結果:Excel VBA - 如果列B包含任何值,則更新列A的值。如果列B不包含值,則不要運行宏

Sub Update_Column_Based_On_Column_Value1() 
On Error Resume Next 
    Dim ws As Worksheet 
    Dim lRow As Long 

    Set ws = ThisWorkbook.Sheets("Sheet1") 

    With ws 
     lRow = .Range("B" & .Rows.Count).End(xlUp).Row 

     .Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).Formula = "=If(B1<>"""",""PREDETERMINED VALUE"","""")" 
     .Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value 
    End With 
End Sub 

當塔B含有一個值的宏將寫在列A「預定值」在相應的小區

當列中根本不包含任何值時會發生問題。會發生什麼情況是宏會將我的新值寫入整個數據集中的幾乎所有空白單元格。

預先感謝您的時間!我很抱歉,如果我的問題不好,我對VBA還是很新的。

+0

我不太明白你的問題,但我認爲你需要改變這一行,你要基於它的價值在一個相當比乙'lRow = .Range(「A」&.Rows。 Count).End(xlUp).Row' – SJR

+0

另一個問題是,您的公式的第一個實例將引用B1,但空白可能不在第1行。 – SJR

+0

您好,@SJR 如果我的要求不是清楚地說明了我可以提供我試圖實現的屏幕截圖。 您對代碼的修改不是我一直在尋找的。當我運行代碼更新列A時,即使列B是空的。 – UserX

回答

0

在註釋部分使用If WorksheetFunction.CountA(ws.Range("B:B")) = 1來避免這個問題是一個很好的嘗試,但可能會有例外,如下所述。使用各種場景(特別是使用空白區域)測試幾次,看看您是否每次都能獲得所需的結果。

.SpecialCells試圖簡化代碼,然而有時候the .SpecialCells(xlCellTypeBlanks) VBA function does not work as expected in Excel

另外,陳述On Error Resume Next不應該儘可能使用。但是,如果您必須,請務必儘快插入On Error GoTo 0語句,因爲您不想屏蔽其他錯誤。

而不是.SpecialCells,您可以使用For Each循環來避免此問題。讓我們來看看它的外觀:

Sub Update_Column_Based_On_Column_Value1() 
    Dim ws As Worksheet, lRow As Long, r As Range 
    Set ws = ThisWorkbook.Sheets("Sheet1") 
    With ws 
     lRow = .Range("B" & .Rows.Count).End(xlUp).Row 
     For Each r In .Range("A1:A" & lRow) 
      If IsEmpty(r) Then 
       r.Formula = "=If(B" & r.Row & "<>"""",""PREDETERMINED VALUE"","""")" 
       r = r.Value 
      End If 
     Next 
    End With 
End Sub 
+0

謝謝你的貢獻,但我找到了適合我的解決方案。我測試了多種場景,每次都有效。請檢查出來,並留下反饋,如果你願意! – UserX

+0

sry mate它沒有。 pl見[截圖](https://i.stack.imgur.com/QhjuJ.png)。只有宏運行前的數據在單元格「G7」中。在宏運行之後,除了單元格「G7」之外的整個範圍'A1:G7'都填充了零。但無論如何,只要您意識到相關風險,就是您的選擇 – curious

0

這裏是每個人的答案!

Sub Update_Column_Based_On_Column_Value_1() 
    On Error Resume Next 
     Dim ws As Worksheet 
     Dim lRow As Long 

     Set ws = ThisWorkbook.Sheets("Sheet1") 

     If WorksheetFunction.CountA(ws.Range("B:B")) = 1 Then 

     Else 

      With ws 
       lRow = .Range("B" & .Rows.Count).End(xlUp).Row 
       .Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=If(LEN(RC2),""NEW TEXT HERE"", TEXT(,))" 
       .Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value 
      End With 
     End If 
    End Sub 
相關問題