Question

我现在已经完成了我想要的工作表来完成我想要它做的事情。然而，代码似乎非常沉重，我的电脑屏幕闪烁，以至于我几乎得到了癫痫发作。我希望也许有一些事情可以做，但我需要你的帮助来实现这个目标。

＆＃34;系统＆＃34;由两个文件组成，一个用户文件（闪烁的文件）和一个数据库文件。

当我运行完整更新或仅运行＆＃34;新项目时＃34;更新，它似乎需要大量的资源，考虑到相当简单的任务和潜在的查找次数，我认为这是不必要的。这一切都是从表格＃S; Sagsnr完成的。＆＃34;在＆＃34; Stackoverflow_dummy.xlsm＆＃34;文件。

我还在下面编写了代码，但是完整但已经过消毒的文件也可以在这里找到：https://spaces.hightail.com/space/vSKXs。

我希望你们能帮助我优化这一点。

Sub Worksheet_UpdateAllItemCostData()

Dim material As Variant
Dim fndEntry As Range
Dim wb1 As Workbook, wb2 As Workbook
Dim lr As Long, I As Long, J As Long
Const sPOS As String = "Pos. "

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wb1 = ActiveWorkbook

J = 0
lr = wb1.Sheets("Sagsnr.").Cells(Rows.Count, "C").End(xlUp).Row

If lr < 21 Then
    Exit Sub
End If

Workbooks.Open Filename:="G:\Backoffice\Tilbudsteam\Kostdatabase\Matcost.xls", ReadOnly:=True
wb1.Sheets("Sagsnr.").Rows("1:1").Hidden = False

Set wb2 = ActiveWorkbook

    For I = 21 To lr


            wb1.Sheets("Sagsnr.").Rows("1:1").Copy
            wb1.Sheets("Sagsnr.").Rows(I).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
            wb1.Sheets("Sagsnr.").Rows(I).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


        material = wb1.Sheets("Sagsnr.").Range("C" & I).Value

    Set fndEntry = wb2.Sheets("Matcost").Range("D:D").Find(What:=material)

    If Not material = "" Then

        J = J + 1
        wb1.Sheets("Sagsnr.").Range("A" & I).Value = sPOS & J

    End If

    If Not fndEntry Is Nothing Then

        'If you want to include the formatting from the source file, use below:
        'wb2.Sheets("Source sheet - change me").Range("source column - change me" & fndEntry.Row).Copy Destination:=wb1.Sheets("destination sheet - change me").Range("destination column - change me" & i)

        'If you want to keep the formatting of the target file, use below:
        'wb1.Sheets("Source sheet - change me").Range("source column - change me" & i).Value = wb2.Sheets("destination sheet").Range("destination column" & fndEntry.Row).Value


            wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value  'Product group
            wb1.Sheets("Sagsnr.").Range("E" & I).Value = wb2.Sheets("Matcost").Range("Q" & fndEntry.Row).Value   'Available Stock
            wb1.Sheets("Sagsnr.").Range("F" & I).Value = wb2.Sheets("Matcost").Range("E" & fndEntry.Row).Value   'Materiale name
            wb1.Sheets("Sagsnr.").Range("H" & I).Value = wb2.Sheets("Matcost").Range("AJ" & fndEntry.Row).Value  'Marked for deletion
            wb1.Sheets("Sagsnr.").Range("I" & I).Value = wb2.Sheets("Matcost").Range("M" & fndEntry.Row).Value   'Datasheet
            wb1.Sheets("Sagsnr.").Range("K" & I).Value = wb2.Sheets("Matcost").Range("P" & fndEntry.Row).Value   'Lotsize
            wb1.Sheets("Sagsnr.").Range("M" & I).Value = wb2.Sheets("Matcost").Range("F" & fndEntry.Row).Value   'Material type (FERT/HAWA)
            wb1.Sheets("Sagsnr.").Range("N" & I).Value = wb2.Sheets("Matcost").Range("N" & fndEntry.Row).Value   'Date of Cost update
            wb1.Sheets("Sagsnr.").Range("O" & I).Value = wb2.Sheets("Matcost").Range("O" & fndEntry.Row).Value   'Last change of cost data
            wb1.Sheets("Sagsnr.").Range("P" & I).Value = wb2.Sheets("Matcost").Range("K" & fndEntry.Row).Value   'Stock category
            wb1.Sheets("Sagsnr.").Range("Q" & I).Value = wb2.Sheets("Matcost").Range("L" & fndEntry.Row).Value   'ABC code
            wb1.Sheets("Sagsnr.").Range("R" & I).Value = wb2.Sheets("Matcost").Range("V" & fndEntry.Row).Value   'Construction weight Cu
            wb1.Sheets("Sagsnr.").Range("S" & I).Value = wb2.Sheets("Matcost").Range("W" & fndEntry.Row).Value   'Construction weight Al
            wb1.Sheets("Sagsnr.").Range("T" & I).Value = wb2.Sheets("Matcost").Range("X" & fndEntry.Row).Value   'Sales weight Cu
            wb1.Sheets("Sagsnr.").Range("U" & I).Value = wb2.Sheets("Matcost").Range("Y" & fndEntry.Row).Value   'Sales weight Al
            wb1.Sheets("Sagsnr.").Range("AC" & I).Value = wb2.Sheets("Matcost").Range("Z" & fndEntry.Row).Value  'Construction weight PE
            wb1.Sheets("Sagsnr.").Range("AD" & I).Value = wb2.Sheets("Matcost").Range("AD" & fndEntry.Row).Value 'PE costs
            wb1.Sheets("Sagsnr.").Range("AE" & I).Value = wb2.Sheets("Matcost").Range("AA" & fndEntry.Row).Value 'Construction weight PVC
            wb1.Sheets("Sagsnr.").Range("AF" & I).Value = wb2.Sheets("Matcost").Range("AE" & fndEntry.Row).Value 'PVC costs
            wb1.Sheets("Sagsnr.").Range("AG" & I).Value = wb2.Sheets("Matcost").Range("AF" & fndEntry.Row).Value 'Other materials costs
            wb1.Sheets("Sagsnr.").Range("AH" & I).Value = wb2.Sheets("Matcost").Range("AB" & fndEntry.Row).Value 'Variable production costs
            wb1.Sheets("Sagsnr.").Range("AI" & I).Value = wb2.Sheets("Matcost").Range("AC" & fndEntry.Row).Value 'Fixed production costs

        End If

    Set fndEntry = wb2.Sheets("Matcost").Range("C:C").Find(What:=material)

        If Not fndEntry Is Nothing Then
        'If you want to include the formatting from the source file, use below:
        'wb2.Sheets("Source sheet - change me").Range("source column - change me" & fndEntry.Row).Copy Destination:=wb1.Sheets("destination sheet - change me").Range("destination column - change me" & i)

        'If you want to keep the formatting of the target file, use below:
        'wb1.Sheets("Source sheet - change me").Range("source column - change me" & i).Value = wb2.Sheets("destination sheet").Range("destination column" & fndEntry.Row).Value

            wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value  'Product group
            wb1.Sheets("Sagsnr.").Range("E" & I).Value = wb2.Sheets("Matcost").Range("Q" & fndEntry.Row).Value   'Available Stock
            wb1.Sheets("Sagsnr.").Range("F" & I).Value = wb2.Sheets("Matcost").Range("E" & fndEntry.Row).Value   'Materiale name
            wb1.Sheets("Sagsnr.").Range("H" & I).Value = wb2.Sheets("Matcost").Range("AJ" & fndEntry.Row).Value  'Marked for deletion
            wb1.Sheets("Sagsnr.").Range("I" & I).Value = wb2.Sheets("Matcost").Range("M" & fndEntry.Row).Value   'Datasheet
            wb1.Sheets("Sagsnr.").Range("K" & I).Value = wb2.Sheets("Matcost").Range("P" & fndEntry.Row).Value   'Lotsize
            wb1.Sheets("Sagsnr.").Range("M" & I).Value = wb2.Sheets("Matcost").Range("F" & fndEntry.Row).Value   'Material type (FERT/HAWA)
            wb1.Sheets("Sagsnr.").Range("N" & I).Value = wb2.Sheets("Matcost").Range("N" & fndEntry.Row).Value   'Date of Cost update
            wb1.Sheets("Sagsnr.").Range("O" & I).Value = wb2.Sheets("Matcost").Range("O" & fndEntry.Row).Value   'Last change of cost data
            wb1.Sheets("Sagsnr.").Range("P" & I).Value = wb2.Sheets("Matcost").Range("K" & fndEntry.Row).Value   'Stock category
            wb1.Sheets("Sagsnr.").Range("Q" & I).Value = wb2.Sheets("Matcost").Range("L" & fndEntry.Row).Value   'ABC code
            wb1.Sheets("Sagsnr.").Range("R" & I).Value = wb2.Sheets("Matcost").Range("V" & fndEntry.Row).Value   'Construction weight Cu
            wb1.Sheets("Sagsnr.").Range("S" & I).Value = wb2.Sheets("Matcost").Range("W" & fndEntry.Row).Value   'Construction weight Al
            wb1.Sheets("Sagsnr.").Range("T" & I).Value = wb2.Sheets("Matcost").Range("X" & fndEntry.Row).Value   'Sales weight Cu
            wb1.Sheets("Sagsnr.").Range("U" & I).Value = wb2.Sheets("Matcost").Range("Y" & fndEntry.Row).Value   'Sales weight Al
            wb1.Sheets("Sagsnr.").Range("AC" & I).Value = wb2.Sheets("Matcost").Range("Z" & fndEntry.Row).Value  'Construction weight PE
            wb1.Sheets("Sagsnr.").Range("AD" & I).Value = wb2.Sheets("Matcost").Range("AD" & fndEntry.Row).Value 'PE costs
            wb1.Sheets("Sagsnr.").Range("AE" & I).Value = wb2.Sheets("Matcost").Range("AA" & fndEntry.Row).Value 'Construction weight PVC
            wb1.Sheets("Sagsnr.").Range("AF" & I).Value = wb2.Sheets("Matcost").Range("AE" & fndEntry.Row).Value 'PVC costs
            wb1.Sheets("Sagsnr.").Range("AG" & I).Value = wb2.Sheets("Matcost").Range("AF" & fndEntry.Row).Value 'Other materials costs
            wb1.Sheets("Sagsnr.").Range("AH" & I).Value = wb2.Sheets("Matcost").Range("AB" & fndEntry.Row).Value 'Variable production costs
            wb1.Sheets("Sagsnr.").Range("AI" & I).Value = wb2.Sheets("Matcost").Range("AC" & fndEntry.Row).Value 'Fixed production costs

        End If

Next I

wb2.Close
wb1.Sheets("Sagsnr.").Rows("1:1").Hidden = True

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub Worksheet_GetNewItemCostData()

Dim material As String
Dim costingdate As Variant
Dim fndEntry As Range, fndCostDate As Range
Dim wb1 As Workbook, wb2 As Workbook
Dim lr As Long, I As Long, J As Long
Const sPOS As String = "Pos. "

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wb1 = ActiveWorkbook

J = 0
lr = wb1.Sheets("Sagsnr.").Cells(Rows.Count, "C").End(xlUp).Row

If lr < 21 Then
    Exit Sub
End If

Workbooks.Open Filename:="G:\Backoffice\Tilbudsteam\Kostdatabase\Matcost.xls", ReadOnly:=True
wb1.Sheets("Sagsnr.").Rows("1:1").Hidden = False

Set wb2 = ActiveWorkbook

    For I = 21 To lr

    wb1.Sheets("Sagsnr.").Rows("1:1").Copy
    wb1.Sheets("Sagsnr.").Rows(I).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
    wb1.Sheets("Sagsnr.").Rows(I).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    material = wb1.Sheets("Sagsnr.").Range("C" & I).Value
    costingdate = wb1.Sheets("Sagsnr.").Range("N" & I).Value

    If Not material = "" Then

        J = J + 1
        wb1.Sheets("Sagsnr.").Range("A" & I).Value = sPOS & J

    End If

    If Not costingdate <> "" Then

        Set fndEntry = wb2.Sheets("Matcost").Range("D:D").Find(What:=material)


        If Not fndEntry Is Nothing Then

        'If you want to include the formatting from the source file, use below:
        'wb2.Sheets("Source sheet - change me").Range("source column - change me" & fndEntry.Row).Copy Destination:=wb1.Sheets("destination sheet - change me").Range("destination column - change me" & i)

        'If you want to keep the formatting of the target file, use below:
        'wb1.Sheets("Source sheet - change me").Range("source column - change me" & i).Value = wb2.Sheets("destination sheet").Range("destination column" & fndEntry.Row).Value

            wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value  'Product group
            wb1.Sheets("Sagsnr.").Range("E" & I).Value = wb2.Sheets("Matcost").Range("Q" & fndEntry.Row).Value   'Available Stock
            wb1.Sheets("Sagsnr.").Range("F" & I).Value = wb2.Sheets("Matcost").Range("E" & fndEntry.Row).Value   'Materiale name
            wb1.Sheets("Sagsnr.").Range("H" & I).Value = wb2.Sheets("Matcost").Range("AJ" & fndEntry.Row).Value  'Marked for deletion
            wb1.Sheets("Sagsnr.").Range("I" & I).Value = wb2.Sheets("Matcost").Range("M" & fndEntry.Row).Value   'Datasheet
            wb1.Sheets("Sagsnr.").Range("K" & I).Value = wb2.Sheets("Matcost").Range("P" & fndEntry.Row).Value   'Lotsize
            wb1.Sheets("Sagsnr.").Range("M" & I).Value = wb2.Sheets("Matcost").Range("F" & fndEntry.Row).Value   'Material type (FERT/HAWA)
            wb1.Sheets("Sagsnr.").Range("N" & I).Value = wb2.Sheets("Matcost").Range("N" & fndEntry.Row).Value   'Date of Cost update
            wb1.Sheets("Sagsnr.").Range("O" & I).Value = wb2.Sheets("Matcost").Range("O" & fndEntry.Row).Value   'Last change of cost data
            wb1.Sheets("Sagsnr.").Range("P" & I).Value = wb2.Sheets("Matcost").Range("K" & fndEntry.Row).Value   'Stock category
            wb1.Sheets("Sagsnr.").Range("Q" & I).Value = wb2.Sheets("Matcost").Range("L" & fndEntry.Row).Value   'ABC code
            wb1.Sheets("Sagsnr.").Range("R" & I).Value = wb2.Sheets("Matcost").Range("V" & fndEntry.Row).Value   'Construction weight Cu
            wb1.Sheets("Sagsnr.").Range("S" & I).Value = wb2.Sheets("Matcost").Range("W" & fndEntry.Row).Value   'Construction weight Al
            wb1.Sheets("Sagsnr.").Range("T" & I).Value = wb2.Sheets("Matcost").Range("X" & fndEntry.Row).Value   'Sales weight Cu
            wb1.Sheets("Sagsnr.").Range("U" & I).Value = wb2.Sheets("Matcost").Range("Y" & fndEntry.Row).Value   'Sales weight Al
            wb1.Sheets("Sagsnr.").Range("AC" & I).Value = wb2.Sheets("Matcost").Range("Z" & fndEntry.Row).Value  'Construction weight PE
            wb1.Sheets("Sagsnr.").Range("AD" & I).Value = wb2.Sheets("Matcost").Range("AD" & fndEntry.Row).Value 'PE costs
            wb1.Sheets("Sagsnr.").Range("AE" & I).Value = wb2.Sheets("Matcost").Range("AA" & fndEntry.Row).Value 'Construction weight PVC
            wb1.Sheets("Sagsnr.").Range("AF" & I).Value = wb2.Sheets("Matcost").Range("AE" & fndEntry.Row).Value 'PVC costs
            wb1.Sheets("Sagsnr.").Range("AG" & I).Value = wb2.Sheets("Matcost").Range("AF" & fndEntry.Row).Value 'Other materials costs
            wb1.Sheets("Sagsnr.").Range("AH" & I).Value = wb2.Sheets("Matcost").Range("AB" & fndEntry.Row).Value 'Variable production costs
            wb1.Sheets("Sagsnr.").Range("AI" & I).Value = wb2.Sheets("Matcost").Range("AC" & fndEntry.Row).Value 'Fixed production costs
        End If

        Set fndEntry = wb2.Sheets("Matcost").Range("C:C").Find(What:=material)

        If Not fndEntry Is Nothing Then

        'If you want to include the formatting from the source file, use below:
        'wb2.Sheets("Source sheet - change me").Range("source column - change me" & fndEntry.Row).Copy Destination:=wb1.Sheets("destination sheet - change me").Range("destination column - change me" & i)

        'If you want to keep the formatting of the target file, use below:
        'wb1.Sheets("Source sheet - change me").Range("source column - change me" & i).Value = wb2.Sheets("destination sheet").Range("destination column" & fndEntry.Row).Value

            wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value  'Product group
            wb1.Sheets("Sagsnr.").Range("E" & I).Value = wb2.Sheets("Matcost").Range("Q" & fndEntry.Row).Value   'Available Stock
            wb1.Sheets("Sagsnr.").Range("F" & I).Value = wb2.Sheets("Matcost").Range("E" & fndEntry.Row).Value   'Materiale name
            wb1.Sheets("Sagsnr.").Range("H" & I).Value = wb2.Sheets("Matcost").Range("AJ" & fndEntry.Row).Value  'Marked for deletion
            wb1.Sheets("Sagsnr.").Range("I" & I).Value = wb2.Sheets("Matcost").Range("M" & fndEntry.Row).Value   'Datasheet
            wb1.Sheets("Sagsnr.").Range("K" & I).Value = wb2.Sheets("Matcost").Range("P" & fndEntry.Row).Value   'Lotsize
            wb1.Sheets("Sagsnr.").Range("M" & I).Value = wb2.Sheets("Matcost").Range("F" & fndEntry.Row).Value   'Material type (FERT/HAWA)
            wb1.Sheets("Sagsnr.").Range("N" & I).Value = wb2.Sheets("Matcost").Range("N" & fndEntry.Row).Value   'Date of Cost update
            wb1.Sheets("Sagsnr.").Range("O" & I).Value = wb2.Sheets("Matcost").Range("O" & fndEntry.Row).Value   'Last change of cost data
            wb1.Sheets("Sagsnr.").Range("P" & I).Value = wb2.Sheets("Matcost").Range("K" & fndEntry.Row).Value   'Stock category
            wb1.Sheets("Sagsnr.").Range("Q" & I).Value = wb2.Sheets("Matcost").Range("L" & fndEntry.Row).Value   'ABC code
            wb1.Sheets("Sagsnr.").Range("R" & I).Value = wb2.Sheets("Matcost").Range("V" & fndEntry.Row).Value   'Construction weight Cu
            wb1.Sheets("Sagsnr.").Range("S" & I).Value = wb2.Sheets("Matcost").Range("W" & fndEntry.Row).Value   'Construction weight Al
            wb1.Sheets("Sagsnr.").Range("T" & I).Value = wb2.Sheets("Matcost").Range("X" & fndEntry.Row).Value   'Sales weight Cu
            wb1.Sheets("Sagsnr.").Range("U" & I).Value = wb2.Sheets("Matcost").Range("Y" & fndEntry.Row).Value   'Sales weight Al
            wb1.Sheets("Sagsnr.").Range("AC" & I).Value = wb2.Sheets("Matcost").Range("Z" & fndEntry.Row).Value  'Construction weight PE
            wb1.Sheets("Sagsnr.").Range("AD" & I).Value = wb2.Sheets("Matcost").Range("AD" & fndEntry.Row).Value 'PE costs
            wb1.Sheets("Sagsnr.").Range("AE" & I).Value = wb2.Sheets("Matcost").Range("AA" & fndEntry.Row).Value 'Construction weight PVC
            wb1.Sheets("Sagsnr.").Range("AF" & I).Value = wb2.Sheets("Matcost").Range("AE" & fndEntry.Row).Value 'PVC costs
            wb1.Sheets("Sagsnr.").Range("AG" & I).Value = wb2.Sheets("Matcost").Range("AF" & fndEntry.Row).Value 'Other materials costs
            wb1.Sheets("Sagsnr.").Range("AH" & I).Value = wb2.Sheets("Matcost").Range("AB" & fndEntry.Row).Value 'Variable production costs
            wb1.Sheets("Sagsnr.").Range("AI" & I).Value = wb2.Sheets("Matcost").Range("AC" & fndEntry.Row).Value 'Fixed production costs
        End If

    End If

Next I

wb2.Close
wb1.Sheets("Sagsnr.").Rows("1:1").Hidden = True

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Answer 1

使用时

wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value  'Product group

Excel必须找到“Sagsnr”表。和“Matcost”以及它们复制的每个单元格的相应范围你可以做的是保存工作表和范围，就像你在循环之前对工作簿一样：

Dim wsTo As Worksheet, wsFrom As Worksheet
Set wsTo = wb1.Sheets("Sagsnr.")
Set wsFrom = wb2.Sheets("Matcost")
Dim rngTo As Range, rngFrom As Range

然后在循环内：

Set rngTo = wsTo.Range("A" & I)
Set rngFrom = wsFrom.Range("A" & fndEntry.Row)

rngTo(, "B") = rngFrom(, "H")  ' Product group
rngTo(, "E") = rngFrom(, "Q")  ' Available Stock
' ... and add the same for the rest of the columns

<小时/> 如果您可以一次复制细胞范围而不是逐个细胞复制细胞范围，那么可以加快速度的是什么例如，在您的情况下，您可以过滤源行并复制列：

Dim materials  ' As Variant
materials = wsTo.Range("C21:C" & lr)
materials = WorksheetFunction.Transpose(materials) 'flips from "vertical" to "horisontal"   
wsFrom.UsedRange.AutoFilter 4, materials, xlFilterValues  ' 4 is column D:D in "Matcost"

' set the copy from and paste to ranges
Set rngFrom = wsFrom.Range("A2:A" & wsFrom.UsedRange.Rows.Count) ' skips the header cells
Set rngTo = wsTo.Range("A21")    ' to paste on row 21

' "rngTo(, "B") = rngFrom(, "H")  ' Product group" becomes:
rngFrom.Columns("H").Copy  ' this will copy only the filtered (visible) cells in column H
rngTo(, "B").PasteSpecial  ' or wsTo.Range("B21").PasteSpecial
' ... and add the same for the rest of the columns 

Application.CutCopyMode = False '"Cancels Cut or Copy mode and removes the moving border"

wsTo.UsedRange.AutoFilter 4 ' optional to clear the filter from column D:D

VBA优秀，闪烁很多，有点慢，帮助我优化

1 个答案: