Question

Sub Insert_1()

    NextLine = Range("asset!B" & Rows.count).End(xlUp).Row + 1
    Range("asset!B" & NextLine) = Range("Sheet3!E5")
    Range("asset!C" & NextLine) = Range("Sheet3!E6")
    Range("asset!D" & NextLine) = Range("Sheet3!E7")
    Range("asset!E" & NextLine) = Range("Sheet3!E8")
    Range("asset!F" & NextLine) = Range("Sheet3!E9")
    Range("asset!G" & NextLine) = Range("Sheet3!E10")
    Range("asset!H" & NextLine) = Range("Sheet3!E12")
    Range("asset!I" & NextLine) = Range("Sheet3!E13")
    Range("asset!J" & NextLine) = Range("Sheet3!E15")
    Range("asset!K" & NextLine) = Range("Sheet3!E16")
    Range("asset!L" & NextLine) = Range("Sheet3!E17")
    Range("asset!M" & NextLine) = Range("Sheet3!E18")
    Range("asset!N" & NextLine) = Range("Sheet3!E19")
    Range("asset!O" & NextLine) = Range("Sheet3!E20")
    Range("asset!P" & NextLine) = Range("Sheet3!E21")
    Range("asset!Q" & NextLine) = Range("Sheet3!E22")

End Sub

我为数据输入表单创建了一个插入按钮，代码可以工作，但是重复。所以我试图改进它，下面是我尝试创建一个For循环。

form_cells = Array("E5", "E6", "E7", "E8", "E9", "E10", "E12", "E13", "E15", "E16", "E17", "E18", "E19", "E20", "E21", "E22")

For x = 0 To UBound(form_cels) - LBound(form_cels) + 1
    Range("asset!" & Split("BCDEFGHIJKLMNOPQ", -1)(form_cels.indexOf(elm)) & NextLine) = Range("Sheet3!" & elm)

Next elm

Answer 1

尝试转置数据。

Sub Insert_1()
    dim NextLine as long
    NextLine = Range("asset!B" & Rows.count).End(xlUp).Row + 1
    Range("asset!B" & NextLine & :G" & NextLine) = _
      application.transpose(Range("Sheet3!E5:E10").value)
    Range("asset!H" & NextLine & :I" & NextLine) = _
      application.transpose(Range("Sheet3!E12:E13").value)
    Range("asset!J" & NextLine & :Q" & NextLine) = _
      application.transpose(Range("Sheet3!E15:E22").value)
End Sub

Answer 2

Sub InsertMe()

    Dim roww As Long
    Dim nextLine As Long
    Dim col As Long

    nextLine = 5
    col = Asc("B")

    For roww = Asc("B") To Asc("Q")
        If roww <> (11 + 61) And roww <> (14 + 61) Then   'rows 11 and 14 are skipped
            Range("Asset!" & Chr(col) & nextLine) = Range("Sheet3!E" & roww - 61)
        End If
        col = col + 1
    Next roww

End Sub

我们的想法是，您有一个从Asc("B")列开始的循环，其为66到Asc("Q")，即81。
然后使用Chr()将其转换回字母。 roww - 61是66-61 = 5，这是Range("Sheet3!E5")的开头。
61故意留作幻数。
变量col与循环分开引入，以确保不会跳过列。
roww用于不破坏.Row的{{1}}属性的智能感知。

Answer 3

你可以使用ArrayList对象：

Sub Insert_1()
    Dim cell As Range

    With CreateObject("System.Collections.ArrayList") ' create and reference ArrayList object
        For Each cell In Worksheets("Sheet3").Range("E5:E22") 'loop through Sheet3 range E5:E22
            .Add cell.Value ' add current cell value to arraylist 
        Next
        .RemoveAt 13 'remove 14th element, i.e. Sheet3 E18 value (Arraylist is 0-based)
        .RemoveAt 10 'remove 11th element, i.e. Sheet3 E15 value 

        Worksheets("asset").Cells(Rows.Count, "B").End(xlUp).Offset(1).Resize(, .Count).Value = .ToArray 'write ArrayList values in "asset" sheet column B from last not empty value rightwards 
    End With
End Sub

虽然更多传统的方式可能如下：

Sub Insert_1()
    Dim iCol As Long
    Dim cell As Range

    With Worksheets("asset").Cells(Rows.Count, "B").End(xlUp).Offset(1)' reference "asset" sheet column B first empty row after last not empty one
        For Each cell In Worksheets("Sheet3").Range("E5:E14, E16:E17, E19:E22")' loop through wanted "Sheet3" range
            .Offset(, iCol) = cell.Value 'write current cell value in referenced cell offsetted 'iCol' columns 
            iCol = iCol + 1 'update column offset
        Next
    End With
End Sub

或使用Select Case语法：

Sub Insert_1()
    Dim iCol As Long
    Dim cell As Range

    With Worksheets("asset").Cells(Rows.Count, "B").End(xlUp).Offset(1) ' reference "asset" sheet column B first empty row after last not empty one
        For Each cell In Worksheets("Sheet3").Range("E5:E22") ' loop through "Sheet3" range encompassing both wanted and unwanted values
            Select Case cell.Row 'query cuurrent cell row index
                Case 5 To 14, 16, 17, 19 To 22 ' if it matches any valid one
                    .Offset(, iCol) = cell.Value  'write current cell value in referenced cell offsetted 'iCol' columns 
                    iCol = iCol + 1  'update column offset
            End Select
        Next
    End With
End Sub

在VBA中循环遍历单元格

3 个答案: