Question

如果满足某些条件，我尝试将某些值从数据列表映射到另一个工作表。我以前使用数组做过这个，但现在我遇到运行时错误，我无法调试。映射的工作原理如下（假设满足条件）：列A到A，B到B，AK到C，AL到D和AM到E.

Sub newcontracts()
    Dim source As Variant
    Dim destination As Variant
    Dim j As Integer
    Dim x As Integer
    Dim LastRow As Long

    source = Array("A", "B", "AK", "AL", "AM")
    desitnation = Array("a", "b", "c", "d", "e")

    LastRow = ThisWorkbook.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
    LastRow3 = ThisWorkbook.Sheets("New Contracts").Cells(Rows.Count, 1).End(xlUp).Row

    Worksheets("New Contracts").Range("A2:i10").ClearContents

    With Worksheets(2)
        For x = 11312 To LastRow
            If (IsEmpty(Cells(x, 39)) = False Or Cells(x, 39) <> 0) And Cells(x, 40) = "no" Then
                For j = 0 To 4
                    .Range(source(j) & x).Copy Sheets("New Contracts").Range(destination(j) & Rows.Count).End(xlUp)(1)
                Next j
            End If
        Next x
    End With
End Sub

万分感谢！

Answer 1

所以这是代码的新迭代，似乎正在起作用。 @Peh，我不确定是否必须指定每张纸。正如我之前宣布了什么表，但你注意到了你的观点。无论如何...这里是代码......我将很快尝试Ralphs版本...再次感谢大家的意见

Sub newcontracts()

Dim source As Variant
Dim destination As Variant
Dim j As Integer
Dim x As Integer
Dim LastRow As Long
Dim LastRow3 As Long

source = Array("A", "B", "AK", "AL", "AM")
destination = Array("a", "b", "c", "d", "e")


LastRow3 = ThisWorkbook.Sheets("New Contracts").Cells(Rows.Count, 1).End(xlUp).Row

Worksheets("New Contracts").Range("A2:i10").ClearContents

With Worksheets(2)

LastRow = .Cells(Rows.Count, 1).End(xlUp).Row

For x = 25 To LastRow

If .Rows(x).EntireRow.Hidden = False Then

If (IsEmpty(.Cells(x, 39)) = False Or .Cells(x, 39) <> 0) And .Cells(x, 40) = "no" Then
  For j = 0 To 4
.Range(source(j) & x).Copy Sheets("New Contracts").Range(destination(j) & Rows.Count).End(xlUp)(2)
Next j
End If
End If
Next x




End With

End Sub

使用循环和数组将某些值从一个工作表映射到另一个工作表

1 个答案: