vba - 将数据范围或字符串从 excel 文件加载到数组然后拆分为数组

Question

有人可以帮助我吗？我这里的代码可以将整行复制为 2 行。在复制第一整行之后，我想将范围“G”中的字符串加载到数组中，这样我就可以获得计划插入“厚度”和“宽度”列中的某些字符串，以便我用来计算“重量”的“配置文件类型”。如果您会看到我在代码中有一个数组。但是该数组对我的工作方式不同，我很难满足我需要的要求。我的代码中的数组使用 "X"作为​​分隔符拆分字符串。一旦字符串被拆分，它将为每个拆分字符串添加另一个单元格。我想要的不是在列中而是在数组中进行拆分，以便我可以维护 G 中的数据。我将使用数组中分配的字符串来获取轮廓的“厚度和宽度”，即“厚度为 15，宽度为 150”。如果有任何方法可以使用其他代码做同样的事情，那么简化代码会更有帮助。
提醒 Profiletype 字符串的长度不同。有时轮廓宽度为 4 位 (LB1000X4500X12/15)

下面是我的工作表的快照，供您确定结果是什么。

Private Sub CommandButton2_Click()

Dim lastrow As Long
Dim i As Integer
Dim icount As Integer
Dim x As Long

    For x = ActiveSheet.UsedRange.Rows.CountLarge To 1 Step -1

        If Cells(x, "F") = "LB" Then
        Cells(x, "F") = "ComP"
        Cells(x + 1, "F").EntireRow.Insert
        Cells(x, "F").EntireRow.Copy Cells(x + 1, "F").EntireRow

        'array
        'Columns("G:G").NumberFormat = "@"
        Dim c As Long, r As Range, v As Variant, d As Variant

    For i = 2 To Range("G" & Rows.Count).End(xlUp).Row '2 to 16 cell
        'v = Split (range("G" & i), "X")
        v = Split((Cells(x, "G") & i), "x")
        c = c + UBound(v) + 1

    'Next i


    For i = 2 To c

        If Range("G" & i) <> "" Then
            Set r = Range("G" & i)
            Dim arr As Variant
            arr = Split(r, "X")
            Dim j As Long
            r = arr(0)

    For j = 1 To UBound(arr)

        Rows(r.Row + j & ":" & r.Row + j).Insert Shift:=xlDown
        r.Offset(j, 0) = arr(j)
        r.Offset(j, -1) = r.Offset(0, -1)
        r.Offset(j, -2) = r.Offset(0, -2)

    Next j

        End If
    Next i
End If
Next x


End Sub

Answer 1

这是做你想做的吗？在工作簿副本中运行以确保安全。

Option explicit

Private Sub CommandButton2_Click()

'Bit redundant, would be better if you fully qualify workbook and worksheet with actual names.'
Dim TargetWorksheet as worksheet
Set TargetWorksheet = Activesheet 

With application
.screenupdating = false
.calculation = xlcalculationmanual
End with


With TargetWorksheet

.range("G:G").numberformat = "@"

Dim RowIndex As Long

For RowIndex = .usedrange.rows.countlarge to 1 step -1

If .Cells(RowIndex, "F").value2 = "LB" Then

.Cells(RowIndex, "F").value2 = "ComP"
.Cells(RowIndex + 1, "F").EntireRow.Insert
.Cells(RowIndex, "F").EntireRow.Copy .Cells(RowIndex + 1, "F").EntireRow

Dim SplitProfileType() as string
SplitProfileType = split(mid(.cells(RowIndex+1,"G").value2,3), "X") ' assumes first two characters will always be LB, that it is safe to ignore them and start from third character.'

' Write thickness'
.cells(RowIndex+1, "H").value2 = cdbl(mid(SplitProfileType(ubound(SplitProfileType)),instrrev(SplitProfileType(ubound(SplitProfileType)),"/",-1,vbbinarycompare)+1)

' Write width'
.cells(RowIndex+1, "i").value2 = cdbl(SplitProfileType(1))

    ' Calculate weight'
.cells(RowIndex+1,"K").value2 = .cells(RowIndex+1,"H").value2 * .cells(RowIndex+1,"I").value2 * .cells(RowIndex+1,"J").value2

End if

' I think because you are inserting a row below (rather than above/before), your RowIndex remains unaffected and no adjustment is needed to code. I could be wrong. I would need to test it to be sure.'

Next rowindex

End with

With application
.screenupdating = true
.calculation = xlcalculationautomatic
End with

End sub

未经测试，如在移动设备上编写。