Question

列表似乎只是选择列表中的第一个单元格，有人可以告诉我哪里出错了吗？

每当我运行它时，它需要列表中的第一个单元格将该值分配给ATL选项卡中的单元格（然后将运行多个公式）并复制我想要的范围并粘贴到最终选项卡上。我希望它能够做到这一点，但它不会向下移动到其他单元格。我有大约40个细胞应该迭代，但它只是不起作用。有什么想法吗？

Dim x As Integer
Dim List As Range
Dim intcount As Integer
Dim DCs As Worksheet
Dim Form As Worksheet
Dim Final As Worksheet
Dim DCdata As String
Dim wsList As String
Dim rnglistrange As Range


With ThisWorkbook
    Set DCs = .Sheets("List1")
    Set Form = .Sheets("ATL")
    Set Final = .Sheets("Final")
End With

DCs.Select

    intcount = DCs.Cells(Rows.Count, "A").End(xlUp).Row '--Get last row of list.
    Set List = DCs.Range("A1:A" & intcount) '--Qualify our list.

For Each rnglistrange In List '--For every name in list...
        Form.Select
        Range("A2") = List.Value
        Range("A632:N646").Copy
    Final.Select
    ActiveCell.SpecialCells(xlLastCell).Select
    Selection.End(xlToLeft).Select
    Selection.Offset(2, 0).Select
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Next

Answer 1

您商家信息的第25行说明：

Range("A2") = List.Value

将该行更改为：

Range("A2") = rnglistrange.Value

然后您将看到它正在迭代“列表”范围的单元格。

Answer 2

问题在于：

Range("A2") = List.Value

只会将List range的第一个值放在单元格＆＃34; A2＆＃34;

虽然你想放：

Range("A2") = rnglistrange

将当前 List单元格Value放在单元格A2中

但您可能还需要考虑重构代码，其主要目标是避免使用Select / Selection / Activate / ActiveXXX模式完全合格的范围参考，既没有对您实际引用的内容进行松散控制，也没有提高性能（以及屏幕闪烁）

Option Explicit

Sub main()
    Dim listRng As Range, listCell As Range
    Dim DCs As Worksheet, Form As Worksheet, Final As Worksheet

    With ThisWorkbook 
        Set DCs = .Worksheets("List1")
        Set Form = .Worksheets("ATL")
        Set Final = .Worksheets("Final")
    End With

    With DCs
        Set listRng = .Range("A1", .Cells(Rows.count, "A").End(xlUp)) '--Qualify our list.
    End With

    For Each listCell In listRng '--For every name in list...
        With Form
            .Range("A2") = listCell
            .Range("A632:N646").Copy
        End With
        With Final
            With .Cells(Rows.count, "A").End(xlUp).Offset(2)
                .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            End With
        End With
    Next
End Sub

循环不迭代列表vba

2 个答案: