Question

我创建了一个循环，该循环将一个单元格的值传递到同一张纸下的另一个单元格。预期的结果应该是这样，如果循环运行，它将获得第一个值，然后运行我创建的过程接下来覆盖同一单元格，获取第二个值，然后再次执行我创建的过程，然后获取第三值..覆盖单元格..exec proc，依此类推... 但是我的代码只会得到选择的最后一个值。

    Public Sub SpecNum()

    Dim lrow As Long

    Range("A2").Select
    lrow = Selection.End(xlDown).Row

        For x = 2 To lrow

            Range("C2").Value2 = Cells(x, 1).Value2

        Next x
            Number

    End Sub


    Public Sub Number()

    Dim SpecNum, pref, lastCell As String
    Dim lrow As Long

    SpecNum = Range("C2").Value2


        For x = 2 To 6

            Worksheets("Sheet3").Select
            pref = Cells(x, "E").Value2
            Cells(x, "C").Value2 = SpecNum & pref
            Range("C2", Range("C2").End(xlToRight).End(xlDown)).Copy

        Next x

            Worksheets("Sheet1").Select
            Range("A250").Select
            Selection.End(xlUp).Select
            ActiveCell.Offset(1, 0).Select
            ActiveSheet.Paste

    End Sub

在循环内移动数字时输出。它使值翻倍/三倍

预期结果：

Answer 1

修改了循环结构。可以尝试

或者可以在单一过程中选择简化的解决方案

Public Sub SpecNum()

    Dim lrow As Long

    Range("A2").Select
    lrow = Selection.End(xlDown).Row

        For X = 2 To lrow
        Range("C2").Value2 = Cells(X, 1).Value2
        Number
        Next X


    End Sub

    Public Sub Number()

    Dim SpecNum, pref, lastCell As String
    Dim lrow As Long

    SpecNum = Range("C2").Value2


        For X = 2 To 6

            Worksheets("Sheet3").Select
            pref = Cells(X, "E").Value2
            Cells(X, "C").Value2 = SpecNum & pref
            'Range("C2", Range("C2").End(xlToRight).End(xlDown)).Copy
            Range("C" & X, Range("C" & X).End(xlToRight)).Copy

            Worksheets("Sheet1").Select
            Range("A15").End(xlDown).End(xlDown).End(xlUp).Select
            ActiveCell.Offset(1, 0).Select
            ActiveSheet.Paste
    Next X

    End Sub

希望它会起作用

Answer 2

我稍微重构了您的代码。首先-您应该学习如何避免使用选择（How to avoid using Select in Excel VBA）。不带选择的代码更灵活，更不混乱。

希望它可以按您的意愿工作：

Option Explicit
Public Sub SpecNum()
Dim lrow    As Long
Dim x       As Long
Dim wb      As Workbook
Dim ws      As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet3")

lrow = ws.Range("A2").End(xlDown).row

For x = 2 To lrow
    ws.Range("C2").Value2 = ws.Cells(x, 1).Value2
    Number
Next x
End Sub

Public Sub Number()
Dim SpecNum As String
Dim pref    As String
Dim lrow    As Long
Dim x       As Long
Dim wb      As Workbook
Dim ws3     As Worksheet
Dim ws1     As Worksheet
Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("Sheet1")
Set ws3 = wb.Worksheets("Sheet3")

SpecNum = ws3.Range("C2").Value2

For x = 2 To 6
    pref = ws3.Cells(x, "E").Value2
    ws3.Cells(x, "C").Value2 = SpecNum & pref
Next x
ws3.Range("C2", ws3.Range("C2").End(xlToRight).End(xlDown)).Copy

ws1.Range("A250").End(xlUp).Offset(1, 0).PasteSpecial
End Sub

VBA宏-循环并获取值，然后覆盖所需的单元格

2 个答案: