Excel 将范围对象用作循环的一部分_Excel_Vba

Excel 将范围对象用作循环的一部分

excel vba

Excel 将范围对象用作循环的一部分,excel,vba,Excel,Vba,我在下面粘贴了整个宏，但这是重要的部分 Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value Range("D2:D10000").Value = Range("D2").Offset(-1, 1).Value Range("F2:F10000").Value = Range("F2").Offset(-1, 1).Value Range("H2:H10000").Value = Range("H2").Of

我在下面粘贴了整个宏，但这是重要的部分

Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value    
Range("D2:D10000").Value = Range("D2").Offset(-1, 1).Value    
Range("F2:F10000").Value = Range("F2").Offset(-1, 1).Value    
Range("H2:H10000").Value = Range("H2").Offset(-1, 1).Value

它按原样工作，只是创建了不必要的数据，因为我不知道如何在范围对象中使用变量名。我的范围目前是硬编码的，例如（“A1:A1000”），而我希望它类似于（“A1:A&LastRow”）

此外，我还必须显式调用要复制的列名，因为该范围不接受类似（“currentColumn&1:currentColumn&LastRow”）的变量名

有没有一种方法可以使用可变名称作为范围对象的一部分，这样我们就可以在循环中使用它们

Sub prepareWorkbook()

Dim wbk As Workbook
Set wbk = ThisWorkbook
Dim wks As Worksheet
Set wks = wbk.ActiveSheet
Dim colx As Long
Dim ColumnCount As Long
Dim MySheetName As String
MySheetName = "Import"
LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

'copy the worksheet and rename it before editing
Sheets(1).Copy After:=Sheets(1)
ActiveSheet.Name = MySheetName

'identify the Id column and move it to 1st column
Dim answer As Variant
Dim IdColumn As Range
answer = Application.InputBox("Enter Letter of Id column")

If Columns(answer).Column = 1 Then
Else
    'cut Id column from current location and insert it at column index 1
    Columns(answer).Select
    Selection.Cut
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
End If

'trim the PartNumber column of any trailing spaces
Dim c As Range
For Each c In Range("A1:A10000")
    c.Value = Application.Trim(Replace(c.Value, Chr(160), Chr(32)))
Next

' insert column every other column
' Loop through number of columns.
ColumnCount = Application.WorksheetFunction.CountA(Rows(1)) * 2

'step 2 means skip every other
For colx = 2 To ColumnCount Step 2
    Columns(colx).Insert Shift:=xlToRight
Next

Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value    
Range("D2:D10000").Value = Range("D2").Offset(-1, 1).Value    
Range("F2:F10000").Value = Range("F2").Offset(-1, 1).Value    
Range("H2:H10000").Value = Range("H2").Offset(-1, 1).Value

wks.Cells.EntireColumn.AutoFit
MsgBox ("Done")

End Sub

类似于：

Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("B2:B" & LastRow).Value = Range("B2").Offset(-1, 1).Value
Range("D2:D" & LastRow).Value = Range("D2").Offset(-1, 1).Value
Range("F2:F" & LastRow).Value = Range("F2").Offset(-1, 1).Value
Range("H2:H" & LastRow).Value = Range("H2").Offset(-1, 1).Value

比如：

Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("B2:B" & LastRow).Value = Range("B2").Offset(-1, 1).Value
Range("D2:D" & LastRow).Value = Range("D2").Offset(-1, 1).Value
Range("F2:F" & LastRow).Value = Range("F2").Offset(-1, 1).Value
Range("H2:H" & LastRow).Value = Range("H2").Offset(-1, 1).Value

虽然这个答案不适用于你的情况，但我觉得这可以帮助你回答一些问题

指定范围时，可以分隔列（字母）和行（数字），并使用自己的变量。在for循环中，这可能看起来像

for i = 1 to 100
     Range("A" & i).Value = Range("A"&i).Offset(, 1).Value
next

还可以使用以下方法确定选定单元格的行数：

dim RowNb as long
RowNb = (ActiveCell.Row)

这也适用于列，并且可以在循环中使用，就像我在开头提到的那样

虽然这个答案不适用于你的情况，但我觉得这可能有助于回答你的一些问题

指定范围时，可以分隔列（字母）和行（数字），并使用自己的变量。在for循环中，这可能看起来像

for i = 1 to 100
     Range("A" & i).Value = Range("A"&i).Offset(, 1).Value
next

还可以使用以下方法确定选定单元格的行数：

dim RowNb as long
RowNb = (ActiveCell.Row)

这也适用于列，并且可以在循环中使用，就像我在开头提到的那样

假设您正在运行此处添加的工作表中的代码：

'copy the worksheet and rename it before editing
Sheets(1).Copy After:=Sheets(1)
ActiveSheet.Name = MySheetName

也不确定这段代码的目的是什么，不过在示例中使用了它

Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value

试试这个：

Dim lLastRow As Long
lLastRow = wbk.Worksheets(MySheetName).UsedRange.SpecialCells(xlLastCell).Row

Rem This updates only columns B, D, F & H - adjust as needed
For colx = 2 To 8 Step 2
    With wbk.Worksheets(MySheetName)
        Rem Creates Range as Range(Cells(rIni,cIini), Cells(rEnd,cEnd))
        rem Corresponding code for "Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value" (see comment above)
        Range(.Cells(2, colx), .Cells(lLastRow, colx)) = .Cells(2, colx).Offset(-1, 1).Value
End With: Next

假设您正在此处添加的工作表中运行代码：

'copy the worksheet and rename it before editing
Sheets(1).Copy After:=Sheets(1)
ActiveSheet.Name = MySheetName

也不确定这段代码的目的是什么，不过在示例中使用了它

Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value

试试这个：

Dim lLastRow As Long
lLastRow = wbk.Worksheets(MySheetName).UsedRange.SpecialCells(xlLastCell).Row

Rem This updates only columns B, D, F & H - adjust as needed
For colx = 2 To 8 Step 2
    With wbk.Worksheets(MySheetName)
        Rem Creates Range as Range(Cells(rIni,cIini), Cells(rEnd,cEnd))
        rem Corresponding code for "Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value" (see comment above)
        Range(.Cells(2, colx), .Cells(lLastRow, colx)) = .Cells(2, colx).Offset(-1, 1).Value
End With: Next

在您的描述中，最明显的一点是没有提到工作表中数据的性质。您简短地提到了

A1

，但您的范围值分配从第2行开始，因此可以推断第1行包含列标题标签

Sub prepareWorkbook()
    Dim wbk As Workbook, wks As Worksheet
    Dim colx As Long
    Dim lc As Long, lr As Long
    Dim MySheetName As String

    Set wbk = ThisWorkbook    'no idea what this does
    Set wks = wbk.ActiveSheet 'no idea what this does
    MySheetName = "Import"

    'no idea what this does or what sht is
    'LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

    'copy the worksheet and rename it before editing
    Sheets(1).Copy After:=Sheets(1)

    With Sheets(2)
        .Name = MySheetName

        If CBool(Application.CountIf(.Rows(1), "PartNumber")) Then
            colx = Application.Match("PartNumber", .Rows(1), 0)
        Else
            colx = .Range(Application.InputBox("Enter Letter of Id column") & 1).Column
        End If
        If .Columns(colx).Column > 1 Then
            'cut Id column from current location and insert it at column index 1
            .Columns(colx).Cut
            .Columns(1).Insert Shift:=xlToRight
        End If

        'quickest way to trim trailing spaces is with Text-to-Columns, Fixed Width
        With .Columns(1)
            .TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
        End With

        ' insert column every other column (working backwards toward A1)
        For lc = .Cells(1, Columns.Count).End(xlToLeft).Column To 2 Step -1
            .Columns(lc).Insert Shift:=xlToRight
        Next lc

        For lc = (.Cells(1, Columns.Count).End(xlToLeft).Column - 1) To 2 Step -2
            'let's put the row-by-row value in instead of a single value into all cells
            lr = .Cells(Rows.Count, lc + 1).End(xlUp).Row
            With .Cells(2, lc).Resize(lr - 1, 1)
                .Cells = .Offset(-1, 1).Value
                .EntireColumn.AutoFit
            End With
        Next lc

    End With

    Set wbk = Nothing
    Set wks = Nothing

End Sub

以代码注释的形式进行解释。

在您的描述中，最明显的一点是没有提到工作表中数据的性质。您简短地提到了

A1

，但您的范围值分配从第2行开始，因此可以推断第1行包含列标题标签

Sub prepareWorkbook()
    Dim wbk As Workbook, wks As Worksheet
    Dim colx As Long
    Dim lc As Long, lr As Long
    Dim MySheetName As String

    Set wbk = ThisWorkbook    'no idea what this does
    Set wks = wbk.ActiveSheet 'no idea what this does
    MySheetName = "Import"

    'no idea what this does or what sht is
    'LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

    'copy the worksheet and rename it before editing
    Sheets(1).Copy After:=Sheets(1)

    With Sheets(2)
        .Name = MySheetName

        If CBool(Application.CountIf(.Rows(1), "PartNumber")) Then
            colx = Application.Match("PartNumber", .Rows(1), 0)
        Else
            colx = .Range(Application.InputBox("Enter Letter of Id column") & 1).Column
        End If
        If .Columns(colx).Column > 1 Then
            'cut Id column from current location and insert it at column index 1
            .Columns(colx).Cut
            .Columns(1).Insert Shift:=xlToRight
        End If

        'quickest way to trim trailing spaces is with Text-to-Columns, Fixed Width
        With .Columns(1)
            .TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
        End With

        ' insert column every other column (working backwards toward A1)
        For lc = .Cells(1, Columns.Count).End(xlToLeft).Column To 2 Step -1
            .Columns(lc).Insert Shift:=xlToRight
        Next lc

        For lc = (.Cells(1, Columns.Count).End(xlToLeft).Column - 1) To 2 Step -2
            'let's put the row-by-row value in instead of a single value into all cells
            lr = .Cells(Rows.Count, lc + 1).End(xlUp).Row
            With .Cells(2, lc).Resize(lr - 1, 1)
                .Cells = .Offset(-1, 1).Value
                .EntireColumn.AutoFit
            End With
        Next lc

    End With

    Set wbk = Nothing
    Set wks = Nothing

End Sub

解释作为代码中的注释。

您不能在没有用户干预的情况下通过名称找到PartNumber列吗？您是否尝试输入一个值（例如

范围（“B2”）。偏移量（-1，1）。值

）是否希望逐行值传输偏移-1行？partNumber字段并不总是第一列，也不总是命名为partNumber。您是否可以通过名称在没有用户干预的情况下找到partNumber列？您是否尝试输入一个值（例如

范围（“B2”）.offset（-1，1）.value

）是否要逐行值转移偏移-1行？partNumber字段并不总是第一列，也不总是命名为partNumber