基于模式匹配将文本格式的值复制到不同的单元格

Question

这是我从第1行第1行开始的数据

问题1）需要公式来计算具有前3个字符的模式匹配的行为000,010,020,999 ??

在上面的示例中，它将是5，这5行是文件的标题;这意味着我只有11行数据，其中前3个字符是030

问题2）需要宏将A列的上述数据复制到其他列的G，H，I，J，K，L，M和N，按照以下规则从第2行开始到第12行< / p>

COLUMN B ===> start="4" length="5" where Record Type = 000  
COLUMN C ===> start="20" length="8" format="MMddyyyy" where Record Type = 000  
COLUMN D ===> start="28" length="3" where Record Type = 000  
COLUMN E ===> start="4" length="25" where Record Type = 010  
COLUMN F ===> start="60" length="20" where Record Type = 010  
COLUMN G ===> start="12" length="15" where Record Type = 020  
COLUMN H ===> start="65" length="1" where Record Type = 020  
COLUMN I ===> start="66" length="25" where Record Type = 020  
COLUMN J ===> start="4" length="30" where Record Type = 030   
COLUMN K ===> start="34" length="30" where Record Type = 030  
COLUMN L ===> start="64" length="30" where Record Type = 030  
COLUMN M ===> start="94" length="30" where Record Type = 030  
COLUMN N ===> start="154" length="23" where Record Type = 030  

上述规则的o / p仅适用于11行，如下所示。

我已经创建了一个宏，但各个列中的vaules循环给了我更多的输出然后是行数，即11个

我认为循环中存在一些问题。

Macro -  

 Sub Macro_CopyData()

 'clear contents before every run

 Range("B1:X10000").Select
 Selection.ClearContents

 ' converting all fields to text

 Range("B1:X100000").NumberFormat = "@"

Dim myrange, cell As Range

 Dim i, j, k, l As Integer, count, count2 As Integer, ColumnA, ColumnB, ColumnC, data3,   ColumnD, ColumnE, ColumnF, ColumnG, ColumnH, ColumnI, ColumnI, ColumnK, ColumnL, ColumnM  As Variant

'counting number of rows in column A

count = ActiveSheet.Range("A1").End(xlDown).Row
MsgBox count
Set myrange = ActiveSheet.Range("A1", Range("A1").End(xlDown))

  ' assigning column names

Cells(1, 2).Value = "ColumnA"
Cells(1, 3).Value = "ColumnB"
Cells(1, 4).Value = "ColumnC"
Cells(1, 5).Value = "ColumnD"
Cells(1, 6).Value = "ColumnE"
Cells(1, 7).Value = "ColumnF"
Cells(1, 8).Value = "ColumnG"
Cells(1, 9).Value = "ColumnH"
Cells(1, 10).Value = "ColumnI"
Cells(1, 11).Value = "ColumnJ"
Cells(1, 12).Value = "ColumnK"
Cells(1, 13).Value = "ColumnL"
Cells(1, 14).Value = "ColumnM"

  For Each cell In myrange
  ' assigning values to the variables
    ColumnA = Mid(cell.Value, 4, 5)
    ColumnB = Mid(cell.Value, 20, 8)
    ColumnC = Mid(cell.Value, 28, 3)
    ColumnD = Mid(cell.Value, 4, 25)
    ColumnE = Mid(cell.Value, 60, 20)
    ColumnF = Mid(cell.Value, 12, 15)
    ColumnG = Mid(cell.Value, 65, 1)
    ColumnH = Mid(cell.Value, 66, 25)
    ColumnI = Mid(cell.Value, 4, 30)
    ColumnJ = Mid(cell.Value, 34, 30)
    ColumnK = Mid(cell.Value, 64, 30)
    ColumnL = Mid(cell.Value, 94, 30)
    ColumnM = Mid(cell.Value, 154, 23)

  For i = 1 To count - 4
  If Left(cell.Value, 3) = "000" Then

   cell.Offset(i, 1).Value = ColumnA
   cell.Offset(i, 2).Value = ColumnB
   cell.Offset(i, 3).Value = ColumnC

   End If
    Next i


  For j = 0 To count - 5
  If Left(cell.Value, 3) = "010" Then
  cell.Offset(j, 4).Value = ColumnD
  cell.Offset(j, 5).Value = ColumnE

   End If
  Next j



  For k = -1 To count - 1

  If Left(cell.Value, 3) = "020" Then
  cell.Offset(k, 6).Value = ColumnF
  cell.Offset(k, 7).Value = ColumnG
  cell.Offset(k, 8).Value = ColumnH
 End If
 Next k


 For l = -2 To count

  If Left(cell.Value, 3) = "030" Then
   cell.Offset(l, 9).Value = ColumnI
   cell.Offset(l, 10).Value = ColumnJ
   cell.Offset(l, 11).Value = ColumnK
   cell.Offset(l, 12).Value = ColumnL
   cell.Offset(l, 13).Value = ColumnM

  End If
  Next l

  Next cell


  End Sub

Answer 1

编辑：试试这个 - 我认为这与您尝试做的很接近。

Sub Macro_CopyData()

    Dim sht As Worksheet, cell As Range, myRange As Range
    Dim arrHeaders, pre, rw As Range
    Dim A, B, C, D, E, F, G, H, I, J, K, L, M

    Set sht = ActiveSheet

    With sht.Range("B1:X10000")
        .ClearContents
        .NumberFormat = "@"
    End With

    arrHeaders = Array("ColumnA", "ColumnB", "ColumnC", "ColumnD", _
                       "ColumnE", "ColumnF", "ColumnG", "ColumnH", _
                       "ColumnI", "ColumnJ", "ColumnK", "ColumnL", _
                       "ColumnM")
    'place headers on sheet
    sht.Cells(1, 2).Resize(1, UBound(arrHeaders) + 1).Value = arrHeaders

    Set myRange = sht.Range(sht.Cells(2, 1), _
                      sht.Cells(Rows.count, 1).End(xlUp))

    For Each cell In myRange.Cells

        Set rw = cell.EntireRow
        pre = Left(cell.Value, 3)

        Select Case pre

            Case "000"
                A = Mid(cell.Value, 4, 5)
                B = Mid(cell.Value, 20, 8)
                C = Mid(cell.Value, 28, 3)

            Case "010"
                D = Mid(cell.Value, 4, 5)
                E = Mid(cell.Value, 20, 8)

            Case "020"
                F = Mid(cell.Value, 12, 15)
                G = Mid(cell.Value, 65, 1)
                H = Mid(cell.Value, 66, 25)

            Case "030"
                rw.Cells(2).Value = A
                rw.Cells(3).Value = B
                rw.Cells(4).Value = C
                rw.Cells(5).Value = D
                rw.Cells(6).Value = E
                rw.Cells(7).Value = F
                rw.Cells(8).Value = G
                rw.Cells(9).Value = H
                rw.Cells(10).Value = Mid(cell.Value, 4, 30)
                rw.Cells(11).Value = Mid(cell.Value, 34, 30)
                rw.Cells(12).Value = Mid(cell.Value, 64, 30)
                rw.Cells(13).Value = Mid(cell.Value, 94, 30)
                rw.Cells(14).Value = Mid(cell.Value, 154, 23)

         End Select

    Next cell

End Sub