用作翻译来复制和粘贴行的二维数组

我有一个电子表格，它可以调出分配了座席的作业。 “代理ID”在列A中，数据在列A-M中。用作翻译来复制和粘贴行的二维数组

我为代理人的每位主管（主管姓氏）都有单独的表格。我很努力地将代理ID编码到宏中，但我想让它工作，以便我可以从翻译表中提取数据，该翻译表只能包含代理ID和相应的主管姓。我无法弄清楚如何逐行解析数据，查找代理ID，然后将该行复制到相应的工作表。

我已经有Agent Agent，Supervisor的翻译工作表（名为sup-agent_Trans）;就是这样，那两列。

这是我到目前为止有：

Dim varList As Variant 
Dim lstRowTrans As Long 
Dim lstRowRework As Long 
Dim rngArr As Range 
Dim rngRwk As Range 
Dim row As Range 
Dim cell As Range 

Application.ScreenUpdating = False 
lstRowTrans = Worksheets("Tech-Sup_Trans").Cells(Rows.Count, "A").End(xlUp).row 
lstRowRework = Worksheets("Rework").Cells(Rows.Count, "A").End(xlUp).row 

varList = Sheets("Tech-Sup_Trans").Range("A1:B" & lstRowTrans) 

Set rngRwk = Sheets("Rework").Range("A1:A" & lstRowRework) 

For Each cell In rngRwk 
For i = LBound(varList, 2) To UBound(varList, 2) 'columns 
    If i = cell(i).Value <> "" Then 
     For j = LBound(varList, 1) To UBound(varList, 1) 'rows 
      If varList(j, cell(i).Value) Then 
      IsInArray = True 
      End If 
     Next j 
    End If 
Next i 
Next cell

来源

2016-05-23 J. Roybomb

好点...不，我没写这段代码。我借用了这段代码，并改变它为我工作。我是VBA的初学者，所以我知道它在做什么，但是我无法围绕数组来包围我的头，以及如何查找一个值并返回另一个值 –

哦，我会开始搞乱！ –

你能给我一个更强的提示吗？ LOL –

所以以后有人如此慷慨地指出，我并不需要使用数组，我用“查找”功能的范围和琢磨出。感谢findwindow！

Dim shtRwk As Worksheet 
Dim shtRef As Worksheet 
Dim DestCell As Range 
Dim rngRwk As Range 
Dim lstRowTrans As Long 
Dim lstRowRework As Long 
Dim rngArr As Range 
Dim row As Range 
Dim cell As Range 
Dim strSup As String 

Set shtRwk = Sheets("Rework") 
Set shtRef = Sheets("Tech-Sup_Trans") 

Application.ScreenUpdating = False 

lstRowTrans = shtRef.Cells(Rows.Count, "A").End(xlUp).row 
lstRowRework = shtRwk.Cells(Rows.Count, "A").End(xlUp).row 

Set rngRwk = Sheets("Rework").Range("A2:A" & lstRowRework) 

For Each cell In rngRwk 
    With shtRef.Range("A1:B" & lstRowTrans) 
     Set DestCell = .Find(What:=cell.Value, _ 
         After:=.Cells(.Cells.Count), _ 
         LookIn:=xlValues, _ 
         LookAt:=xlWhole, _ 
         SearchOrder:=xlByRows, _ 
         SearchDirection:=xlNext, _ 
         MatchCase:=False) 
     If Not DestCell Is Nothing Then 
      strSup = DestCell.Offset(0, 1).Value 
      cell.EntireRow.Copy 
      Sheets(strSup).Select 
      ActiveSheet.Range("A65536").End(xlUp).Select 
      Selection.Offset(1, 0).Select 
      ActiveSheet.Paste 
      shtRwk.Select 
     Else 
      MsgBox "No Sup found for tech " & cell.Value 
     End If 
    End With 
Next cell 

Application.ScreenUpdating = True

来源

2016-05-24 19:36:51

用作翻译来复制和粘贴行的二维数组

回答

相关问题