将具有多行的单元格拆分为行,并使用vba更改分组

时间:2019-11-05 18:01:53

标签: excel vba

我想在“之后”将单元格拆分为TextA,TextB和TextC。并按“文本”类型排序。

我也尝试过:

import re

with open('decompress.txt') as f:
    lines = f.readlines()
#>> lines
# ['word,index\n', 'This,1\n', 'is,2\n', 'an,3\n', 'amazing,4\n', 
#  'abstract,5\n', 'AND,6\n', 'this,7\n', 'the,8\n', 'end,9\n', 'of,10']

但是当我只有一个句子时,excel也要加上一行。

THX

输入:

Input

输出:

Output

1 个答案:

答案 0 :(得分:0)

要根据类型划分的重新排列数据

通过数组分配并使用Application.Index() function的高级重组功能演示一种方法:

Sub ReArrange()
Const GENRE& = 1, ID& = 2, TXT& = 5, TXTA& = 6, TXTB& = 7, TXTC& = 8                     ' columns in variant array v2
With Sheet1                                   ' source sheet's CodeName (!)
  ' [0] define data range
    Dim v, rng As Range, lastRow&
    lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    Set rng = .Range("A1:F" & lastRow)
  ' [1] get data
    v = rng
  ' [2] rearrange array rows & columns (inserting 2 new columns)
    v = Application.Index(v, _
         Application.Transpose(getRows(v)), _
         Array(0, 1, 2, 3, 0, 4, 5, 6))
    v(1, GENRE) = "Genre": v(1, TXT) = "Text"    ' renew headers
  ' [3] Fill in genre & tokens
    Dim i&, ii&, cnt&                             ' item counters
    Dim a&, b&, c&                                ' split item boundaries

    For i = 2 To UBound(v)                        ' loop through v2
        If v(i, ID) <> v(i - 1, ID) Then
            cnt = 0: ii = 0
            a = UBound(Split(v(i, TXTA), "."))    ' items TextA
            b = UBound(Split(v(i, TXTB), "."))    ' items TextB
            c = UBound(Split(v(i, TXTC), "."))    ' items TextC
        End If
        cnt = cnt + 1: ii = ii + 1                ' increment id and genre counters
        Select Case cnt
            Case Is <= a: v(i, GENRE) = "A"
                v(i, GENRE) = "A": v(i, TXT) = Split(v(i, TXTA), ".")(ii - 1): If ii = a Then ii = 0
            Case Is <= a + b
                v(i, GENRE) = "B": v(i, TXT) = Split(v(i, TXTB), ".")(ii - 1): If ii = b Then ii = 0
            Case Is <= a + b + c
                v(i, GENRE) = "C":  v(i, TXT) = Split(v(i, TXTC), ".")(ii - 1): If ii = c Then ii = 0
        End Select

    Next i
End With

  ' [4] write results back whereever you want (reducing array by 3 temporary columns)
    Sheet2.Range("A1").Resize(UBound(v), UBound(v, 2) - 3) = v

End Sub

辅助功能getRows()

Function getRows(arr) As Variant()
' Purpose: return an array of n-times repeated row numbers (based on number of splits)
Dim i&, ii&, j&, cnt&
Dim tmp(), tokens
ReDim tmp(0 To UBound(arr) * 10)
tmp(cnt) = 1: cnt = cnt + 1        ' one title row equals row no 1; increment new rows counter
For i = 2 To UBound(arr)
    For j = 4 To 6                  ' D:F
        tokens = Split(arr(i, j), ".")  ' upper boundary minus one because of right side point
        For ii = LBound(tokens) To UBound(tokens) - 1
            tmp(cnt) = i            ' input row number as often as necessary
            cnt = cnt + 1           ' increment counter
        Next ii
    Next
Next i
ReDim Preserve tmp(0 To cnt - 1)    ' resize array to actual item size
getRows = tmp                       ' return function result array
'Debug.Print Join(tmp, ",")         ' Array(1,2,2,2,3,3,3,3,3,3,3,3,4,4,4,4,4,4,5,5,5,5,5,5,6,6,6,6,6,6)
End Function