Question

我有一对总帐帐户来扫描数据。我需要从描述中找到关键词或短语，然后从这些行中收集某些数据源表（有两个）位于不同的选项卡上，其中的数据需要填充其他5个数据表进行分析。

这是我到目前为止的代码，但速度非常慢。我想建议加快这个过程。我的想法是将所有数据加载到一个数组中，但我不确定这是否会更快。

QA Data K上的那些只需要在被评估的单元格的开头找到它正在查找的字符串，我也在尝试找到一种有效的方法来实现这一点。

Sub Table9052()
Dim i As Integer
Dim wsA As Worksheet: Set wsA = ThisWorkbook.Sheets("QA Data A")
Dim wsK As Worksheet: Set wsK = ThisWorkbook.Sheets("QA Data K")
Dim wsT As Worksheet: Set wsT = ThisWorkbook.Sheets("Tables")
Dim Locker As String
Dim GC As String
Dim MBD As String
Dim DDSV As String
Dim DDSV As String
Locker = "9052 Electronic Lockers"
GC = "9042 Dunkin Donuts Gift Card"
MBD = "MERCHANT BANKCD DEPOSIT"
DDSV = "DD STORED VALU"
SS = "STARBUCKS STOREDVALU"
ColARow = 3
ColFRow = 3
ColKRow = 3
ColPRow = 3
ColURow = 3

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
loo = 1
For i = 6 To wsA.Range("C65536").End(xlUp).Row
    Eval = wsA.Cells(i, 4)
    Temp = wsA.Range("C65536").End(xlUp).Row
    If Eval = Locker Then 'If a locker line copy the cells to ELTable
        wsA.Cells(i, 3).Copy wsT.Cells(ColARow, 1) 'Copy Date to column A
        wsA.Cells(i, 4).Copy wsT.Cells(ColARow, 2) 'Copy Desc to column B
        wsA.Cells(i, 5).Copy wsT.Cells(ColARow, 3) 'Copy Ammt to column C
        wsA.Cells(i, 7).Copy wsT.Cells(ColARow, 4) 'Copy Lodge to column D
        ColARow = ColARow + 1
    End If
    If Eval = GC Then 'If a locker line copy the cells to DDCardTable
        wsA.Cells(i, 3).Copy wsT.Cells(ColPRow, 16) 'Copy Date to column A
        wsA.Cells(i, 4).Copy wsT.Cells(ColPRow, 17) 'Copy Desc to column B
        wsA.Cells(i, 5).Copy wsT.Cells(ColPRow, 18) 'Copy Ammt to column C
        wsA.Cells(i, 7).Copy wsT.Cells(ColPRow, 19) 'Copy Lodge to column D
        ColPRow = ColPRow + 1
    End If
If i = loo * 100 Then
    loo = loo + 1
End If
Next i
loo = 1
For i = 6 To wsK.Range("C65536").End(xlUp).Row
    Temp = wsK.Range("C65536").End(xlUp).Row
    Eval = wsK.Cells(i, 4)
    If Eval = MBD Then 'If a locker line copy the cells to ELTable
        wsK.Cells(i, 3).Copy wsT.Cells(ColFRow, 6) 'Copy Date to column F
        wsK.Cells(i, 4).Copy wsT.Cells(ColFRow, 7) 'Copy Desc to column G
        wsK.Cells(i, 5).Copy wsT.Cells(ColFRow, 8) 'Copy Ammt to column H
        wsK.Cells(i, 7).Copy wsT.Cells(ColFRow, 9) 'Copy Lodge to column I
        ColARow = ColFRow + 1
    End If
    If Eval = DDSV Then 'If a locker line copy the cells to DDCardTable
        wsK.Cells(i, 3).Copy wsT.Cells(ColKRow, 11) 'Copy Date to column K
        wsK.Cells(i, 4).Copy wsT.Cells(ColKRow, 12) 'Copy Desc to column L
        wsK.Cells(i, 5).Copy wsT.Cells(ColKRow, 13) 'Copy Ammt to column M
        wsK.Cells(i, 7).Copy wsT.Cells(ColKRow, 14) 'Copy Lodge to column N
        ColPRow = ColKRow + 1
    End If
    If Eval = SS Then 'If a locker line copy the cells to DDCardTable
        wsK.Cells(i, 3).Copy wsT.Cells(ColURow, 21) 'Copy Date to column U
        wsK.Cells(i, 4).Copy wsT.Cells(ColURow, 22) 'Copy Desc to column V
        wsK.Cells(i, 5).Copy wsT.Cells(ColURow, 23) 'Copy Ammt to column W
        wsK.Cells(i, 7).Copy wsT.Cells(ColURow, 24) 'Copy Lodge to column X
        ColPRow = ColURow + 1
    End If
If i = loo * 100 Then
    loo = loo + 1
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub`

在数据中搜索值并复制该行中的选择单元格

0 个答案: