Question

有人可以帮助我吗？我这里的代码可以复制整行，有2行。复制完第一行后，我想从范围加载字符串＆＃34; G＆＃34;进入数组，这样我就可以得到一些我计划插入的字符串＆＃34;厚度＆＃34;和＆＃34;宽度＆＃34;我可以用来计算＆＃34;重量＆＃34; ＆＃34;配置文件类型＆＃34;。如果你会看到我在代码中有一个数组。但是这个数组对我的工作方式不同，我很难满足我需要的要求。我的代码中的数组使用＆＃34; X＆＃34;分割字符串。作为分隔符。一旦字符串被拆分，它将为每个拆分字符串添加另一个单元格。我想要的是不在列中而是在数组中进行拆分，以便我可以在G中维护数据。我将使用数组中指定的字符串来获得＆＃34;厚度和宽度＆＃34;该轮廓是＆＃34; 15为厚度，150为宽度＆＃34;。如果有任何方法可以使用其他代码做同样的事情，那么简化代码会更有帮助。提醒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

在手机上写的未经测试。

Answer 2

使用数组比在单元格中一对一输入更快。

Sub test()
    Dim vDB, vR()
    Dim i As Long, n As Long, k As Long, j As Integer
    Dim s As String
    vDB = Range("A2", "K" & Range("A" & Rows.Count).End(xlUp).Row)
    n = UBound(vDB, 1)
    ReDim vR(1 To n * 2, 1 To 11)

    For i = 1 To n
        k = k + 2
        s = vDB(i, 7)
        For j = 1 To 11
            vR(k - 1, j) = vDB(i, j)
            vR(k, j) = vDB(i, j)
        Next j
        vR(k - 1, 6) = "comp"
        vR(k, 6) = "comp"
        vR(k, 8) = Split(s, "/")(1)
        vR(k, 9) = Split(s, "X")(1)
        vR(k, 11) = Empty '<~~ This is calculated Weight value place
    Next i
    Range("f1") = "Type"
    Range("a2").Resize(n * 2, 11) = vR

End Sub

Answer 3

它没有重复。

Sub test2()
    Dim vDB, vR()
    Dim i As Long, n As Long, k As Long, j As Integer
    Dim r As Integer
    Dim s As String
    vDB = Range("A2", "K" & Range("A" & Rows.Count).End(xlUp).Row)
    n = UBound(vDB, 1)

    For i = 1 To n
        If vDB(i, 6) = "LB" Then
            r = 2
        Else
            r = 1
        End If
        k = k + r
        ReDim Preserve vR(1 To 11, 1 To k)
        s = vDB(i, 7)
        For j = 1 To 11
            If r = 1 Then
                vR(j, k) = vDB(i, j)
            Else
                vR(j, k - 1) = vDB(i, j)
                vR(j, k) = vDB(i, j)
            End If
        Next j
        If r = 2 Then
            vR(6, k - 1) = "comp"
            vR(6, k) = "comp"
            vR(8, k) = Split(s, "/")(1)
            vR(9, k) = Split(s, "X")(1)
            vR(9, k - 1) = vR(9, k - 1) - vR(8, k)
            vR(11, k - 1) = (vR(8, k - 1) * vR(9, k - 1) * vR(10, k - 1) * 7.85) / 10 ^ 6 '<~~ k2 weight
            vR(11, k) = (vR(8, k) * vR(9, k) * vR(10, k) * 7.85) / 10 ^ 6 '<~~ k3 weight
        End If
    Next i
    Range("f1") = "Type"
    Range("a2").Resize(k, 11) = WorksheetFunction.Transpose(vR)

End Sub

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

3 个答案: