Question

我有一个列，其中包含指向分支的3位数代码。如果一个人在多个部门工作，那么他/她将在该列中引用多个代码。下面是它的样子。

Name  | Branch
ABC   | 423
MNO   |  367325
XYZ   |  414426429

我希望它看起来像这样。

Name |  Branch
ABC  |  423
MNO  |  367
MNO  |  325
XYZ  |  414
XYZ  |  426
XYZ  |  429

我想提取单元格的值，假设让我们说字符串长度为9，然后该人为3个分支工作。我想提取这3个值并复制整行，每行包含一个分支编号。

一些指示：任何人都不能超过 3个分支（因此最大字符串长度 9 ）。大约有 20列。包含分支代码的列始终相同，即列G 。该列还包含空单元格和其他字符串值，例如＆＃39; BIKCJHGT ＆＃39;。 整个列的格式为文本。

任何人都可以给我VBA代码来完成这个吗？

以下是我使用的代码。它没有抛出任何错误，但它也无法正常工作。

Option Explicit

Sub MultiRecords()

    Dim b As Workbook

    Set b = Workbooks.Open("C:\Users\uspola00\Desktop\Headcount_Final.xlsx")
    ActiveWorkbook.Sheets("Headcount").Activate
    ActiveSheet.Range("G1").Select

    Dim ws As Worksheet    
    Set ws = Sheets("Headcount")
    Dim intInsertRows As Integer  
    Dim i As Long

    i = 1

    Application.ScreenUpdating = False

    Do Until i > ws.Range("G" & Rows.Count).End(xlUp).Row
        Dim str As String
        str = LTrim(RTrim(ws.Range("G" & i)))  
        If Len("G" & i) = 9 Then
            intInsertRows = 2
            Range("G" & i + 1 & ":G" & i + intInsertRows).EntireRow.Insert 
            Range("A" & i & ":N" & (i + intInsertRows)).FillDown
            Range("G" & (i + intInsertRows)).Value = Right(str, 3)
            Range("G" & i + 1).Value = Mid(str, 4, 3)
            Range("G" & i).Value = Left(str, 3)
            i = i + intInsertRows
        ElseIf Len("G" & i) = 6 Then
            intInsertRows = 1
            Range("G" & i & ":G" & i + intInsertRows).EntireRow.Insert
            Range("A" & i & ":N" & (i + intInsertRows)).FillDown
            Range("G" & i + intInsertRows).Value = Right(str, 3)
            Range("G" & i).Value = Left(str, 3)
            i = i + intInsertRows
        ElseIf Len("G" & i) = 3 Then
            intInsertRows = 0
            i = i + intInsertRows    
        ElseIf IsEmpty(Range("G" & i)) Then
            i = i + 0
        End If
        i = i + 1 
    Loop   

End Sub

Answer 1

试试这个：

Sub MultiRecords()

    Dim b As Workbook
    Dim ws As Worksheet
    Dim c As Range, v, i As Long

    Set b = Workbooks.Open("C:\Users\uspola00\Desktop\Headcount_Final.xlsx")
    Set ws = b.Sheets("Headcount")
    Set c = ws.Cells(Rows.Count, "G").End(xlUp)

    Do
       v = Trim(c.Value)
       If v Like "######" Or v Like "#########" Then
           i = Len(v) / 3
           c.Offset(1, 0).Resize(i - 1).EntireRow.Insert
           c.Resize(i).EntireRow.FillDown
           c.Value = Left(v, 3)
           c.Offset(1, 0).Value = Mid(v, 4, 3)
           If Len(v) = 9 Then c.Offset(2, 0).Value = Right(v, 3)
       End If

       If c.Row = 1 Then Exit Do
       Set c = c.Offset(-1, 0)
    Loop
End Sub

从单元格中提取值并使用每个单独的值复制整行

1 个答案: