Как упростить код, который объединяет информацию и складывает значения для определенных столбцов?

Question

Я обновляю код VBA, созданный 15 лет назад и созданный кем-то другим. Я должен добавить больше кода, чтобы удовлетворить наши потребности, но я превышаю количество кода, разрешенного для запуска.

У меня есть Продукты в столбце "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 Вопрос Ответ удален вопрос об ошибке двойной петли.

score 1 · Answer 1 · 2011-03-09T19:38:42

Начните с удаления всех ненужных петель. Заменить:

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

score 1 · Accepted Answer · 2011-03-09T19:38:42

Я изменил нужную вам часть, введя логическую переменную 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 ответа2

Всё ещё ищете ответ? Посмотрите другие вопросы с метками microsoft-excel worksheet-function vba.

Как упростить код, который объединяет информацию и складывает значения для определенных столбцов?

2 ответа2

Всё ещё ищете ответ? Посмотрите другие вопросы с метками microsoft-excel worksheet-function vba.

Похожие