☰

如何简化合并信息并为某些列添加值的代码？

tag-icon • tag-icon microsoft-excel worksheet-function vba
如何简化合并信息并为某些列添加值的代码？

我正在修改 15 年前别人编写的一些 VBA 代码。我必须添加更多代码来满足我们的需求，但超出了允许运行的代码量。

我在“AF”列中有一个产品，而我需要将“AH”、“AL”和“AN”列中的值组合在一起。其余列不需要添加。让它在工作表的不同部分输入数据范围。

代码的第一部分清除以前的数据，使其干净。

代码的第二部分在 AF 列中查找一个图块，并在 41-60 行中搜索相同的图块，一旦找到另一个图块（或者如果没有找到），它会在 A 列中放入一些行，并在 41-60 范围内放入一些行。此操作不断重复，直到遍历所有行。这个方法有效，但一旦它进入 41-62 行并添加额外的行，它就不起作用了。

Private Sub FloorWallTileCombo_Click()
Dim TileSearch As String
Dim TotalPrice As Double, TotalSF As Double, TotalSurCap As Double, TotalCorCap As Double
'Dim TotalLF As Double, TotalAccentPcs As Double
For j = 41 To 60
ThisWorkbook.Worksheets("Breakdown").Cells(j, "A") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "D") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "E") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "F") = ""

ThisWorkbook.Worksheets("Breakdown").Cells(j, "H") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "I") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "J") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "K") = ""

ThisWorkbook.Worksheets("Breakdown").Cells(j, "O") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "P") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "Q") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "R") = ""

ThisWorkbook.Worksheets("Breakdown").Cells(8, "B") = "Hand over the calculator, friends don’t let friends derive drunk."
ThisWorkbook.Worksheets("Breakdown").Cells(11, "B") = " "
'Application.ScreenUpdating = False

Next

TotalPrice = 0
TotalSF = 0
TotalSurCap = 0
TotalCorCap = 0

TileSearch = ThisWorkbook.Worksheets("Breakdown").Cells(41, "AF") 'starting Point from import
If TileSearch <> "" Then
    For i = 41 To 60
        If TileSearch = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AF") Then
        'this line shouldnt change once number is in
        'catch = i
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "O") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AB")
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "P") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AC")
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "Q") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AD")
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "A") = TileSearch
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "H") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AK")
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "J") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AM")
        'need for price pulling
        TotalPrice = TotalPrice + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AG")
        TotalSF = TotalSF + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AH")
       'this is for bullnose count
        TotalSurCap = TotalSurCap + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AL")
        TotalCorCap = TotalCorCap + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AQ")
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "D") = TotalPrice
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "I") = TotalSurCap
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "K") = TotalCorCap
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "R") = TotalSF
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "E") = ThisWorkbook.Worksheets("Breakdown").Cells(41, "V")
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "F") = ThisWorkbook.Worksheets("Breakdown").Cells(41, "U")
         End If
    Next i
End If

TotalPrice = 0
TotalSF = 0
TotalSurCap = 0
TotalCorCap = 0

    TileSearch = ThisWorkbook.Worksheets("Breakdown").Cells(42, "AF")
    If TileSearch <> "" And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(41, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(43, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(44, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(45, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(46, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(47, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(48, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(49, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(50, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(51, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(52, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(53, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(54, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(55, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(56, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(57, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(58, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(59, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(60, "A") Then
    For i = 41 To 60
        If TileSearch = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AF") Then
        'this line shouldnt change once number is in
        'catch = i
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "O") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AB")
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "P") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AC")
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "Q") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AD")
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "A") = TileSearch
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "H") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AK")
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "J") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AM")
        'need for price pulling
        TotalPrice = TotalPrice + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AG")
        TotalSF = TotalSF + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AH")
       'this is for bullnose count
        TotalSurCap = TotalSurCap + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AL")
        TotalCorCap = TotalCorCap + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AQ")
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "D") = TotalPrice
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "I") = TotalSurCap
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "K") = TotalCorCap
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "R") = TotalSF
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "E") = ThisWorkbook.Worksheets("Breakdown").Cells(42, "V")
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "F") = ThisWorkbook.Worksheets("Breakdown").Cells(42, "U")
         End If
    Next i
End If

编辑：3-23 问题解答删除了双循环错误问题。

答案1

我通过引入布尔变量改变了您需要的部分bFlag。

Private Sub FloorWallTileCombo_Click()
Dim TileSearch As String
Dim TotalPrice As Double, TotalSF As Double, TotalSurCap As Double, TotalCorCap As Double
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Breakdown")
Dim bFlag As Boolean

ws.Range("A41:A60").Value2 = vbNullString
ws.Range("D41:F60").Value2 = vbNullString
ws.Range("H41:K60").Value2 = vbNullString
ws.Range("O41:R60").Value2 = vbNullString

ws.Cells(8, "B") = "Hand over the calculator, friends don’t let friends derive drunk."
ws.Cells(11, "B") = " "

TotalPrice = 0
TotalSF = 0
TotalSurCap = 0
TotalCorCap = 0

TileSearch = ws.Cells(41, "AF") 'starting Point from import
If TileSearch <> "" Then
    For i = 41 To 60
        If TileSearch = ws.Cells(i, "AF") Then
            'this line shouldnt change once number is in
            ws.Range("O41:Q41").Value = ws.Range("AB" & i & ":AD" & i).Value
            ws.Cells(41, "A") = TileSearch
            ws.Cells(41, "H") = ws.Cells(i, "AK")
            ws.Cells(41, "J") = ws.Cells(i, "AM")
            'need for price pulling
            TotalPrice = TotalPrice + ws.Cells(i, "AG")
            TotalSF = TotalSF + ws.Cells(i, "AH")
            'this is for bullnose count
            TotalSurCap = TotalSurCap + ws.Cells(i, "AL")
            TotalCorCap = TotalCorCap + ws.Cells(i, "AQ")
            ws.Cells(41, "D") = TotalPrice
            ws.Cells(41, "I") = TotalSurCap
            ws.Cells(41, "K") = TotalCorCap
            ws.Cells(41, "R") = TotalSF
            ws.Cells(41, "E") = ws.Cells(41, "V")
            ws.Cells(41, "F") = ws.Cells(41, "U")
        End If
    Next 'i
End If

TotalPrice = 0
TotalSF = 0
TotalSurCap = 0
TotalCorCap = 0

TileSearch = ws.Cells(42, "AF")
For i = 43 To 60
    If Not TileSearch <> ws.Cells(i, "A") Then
        bFlag = True
        Exit For
    End If
Next

If TileSearch <> "" And TileSearch <> ws.Cells(41, "A") And bFlag = False Then
    For i = 41 To 60
        If TileSearch = ws.Cells(i, "AF") Then
            'this line shouldnt change once number is in
            ws.Range("O42:Q42").Value = ws.Range("AB" & i & ":AD" & i).Value
            ws.Cells(42, "A") = TileSearch
            ws.Cells(42, "H") = ws.Cells(i, "AK")
            ws.Cells(42, "J") = ws.Cells(i, "AM")
            'need for price pulling
            TotalPrice = TotalPrice + ws.Cells(i, "AG")
            TotalSF = TotalSF + ws.Cells(i, "AH")
            'this is for bullnose count
            TotalSurCap = TotalSurCap + ws.Cells(i, "AL")
            TotalCorCap = TotalCorCap + ws.Cells(i, "AQ")
            ws.Cells(42, "D") = TotalPrice
            ws.Cells(42, "I") = TotalSurCap
            ws.Cells(42, "K") = TotalCorCap
            ws.Cells(42, "R") = TotalSF
            ws.Cells(42, "E") = ws.Cells(42, "V")
            ws.Cells(42, "F") = ws.Cells(42, "U")
        End If
    Next 'i
End If

没有End Sub，所以我认为这个子程序会继续。所以也请添加

Set ws = Nothing

在End Sub声明之前

答案2

首先删除所有不必要的循环。替换：

For j = 41 To 60
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "A") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "D") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "E") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "F") = ""

    ThisWorkbook.Worksheets("Breakdown").Cells(j, "H") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "I") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "J") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "K") = ""

    ThisWorkbook.Worksheets("Breakdown").Cells(j, "O") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "P") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "Q") = ""
Next j

和：

With ThisWorkbook.Worksheets("Breakdown")
    .Range("A41:A60") = ""
    .Range("D41:F60") = ""
    .Range("H41:K60") = ""
    .Range("O41:Q60") = ""
End With

相关内容