循环通过VBA中的单元格

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

I have created an insert button for a data entry form, the code works but is repetitive. So i tried to improve it, below is my attempt at creating a For loop.

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

Try transposing the data.

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

• The idea is that you have a loop from column Asc("B") which is 66 to Asc("Q") , which is 81.

• Then you use Chr() to convert it back to letters. roww - 61 is 66-61 = 5 , which is the start of Range("Sheet3!E5") .

• 61 is left as a magic number on purpose.

• A variable col is introduced separately from the loop, to make sure that columns are not skipped.

• The roww is used not to break the IntelliSense, of the property .Row of Range .

Answer 3

you could use ArrayList object:

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

---

while a more conventional way could be the following:

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

---

or, with a Select Case syntax:

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