gpt4 book ai didi

vba - Excel循环遍历列表,转置并根据单元格内容创建矩阵

转载 作者:行者123 更新时间:2023-12-04 22:09:52 29 4
gpt4 key购买 nike

我收到一个 500k+ 行的大文件,但所有内容都在 A 列中。我需要运行一个宏,将数据转换为矩阵形式,但只有在找到 "KEY*" 时才会创建一个新行在事件单元中。例如:

| KEY 4759839 | asljhk | 35049 | | sklahksdjf|
| KEY 359 | skj | 487 |y| 2985789 |

我文件中的上述数据最初在 A 列中如下所示:

KEY 4759839
asljhk
35049

sklahksdjf
KEY 359
skj
487
y
2985789

注意事项:
  • 空白单元格也需要转置,所以宏不能基于emptyCell
  • 停止
  • KEY 之间的单元格数量不是恒定的,因此实际上需要读取单元格以了解是否应该创建新行
  • 它可以根据一行中的 20 个空单元格停止,也可以提示输入最大行数
  • (可选)如果一行中的最后一项有某种视觉指示器会很好,这样就可以判断最后一项是否为空白单元格

  • 我四处搜索,发现一个宏具有相同的一般主题,但它基于每 6 行,我没有足够的知识来尝试修改它以适应我的情况。但如果它在这里有帮助,那就是:
    Sub kTest()
    Dim a, w(), i As Long, j As Long, c As Integer
    a = Range([a1], [a500000].End(xlUp))
    ReDim w(1 To UBound(a, 1), 1 To 6)
    j = 1
    For i = 1 To UBound(a, 1)
    c = 1 + (i - 1) Mod 6: w(j, c) = a(i, 1)
    If c = 6 Then j = j + 1
    Next i
    [c1].Resize(j, 6) = w
    End Sub

    我将不胜感激您能给我的任何帮助!

    最佳答案

    这适用于您在问题中提供的示例数据 - 它在从 B1 开始的表中输出结果。它在我的机器上运行 500k 行不到一秒。

    Sub kTest()
    Dim originalData As Variant
    Dim result As Variant
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim countKeys As Long
    Dim countColumns As Long
    Dim maxColumns As Long

    originalData = Range([a1], [a500000].End(xlUp))

    countKeys = 0
    maxColumns = 0

    'Calculate the number of lines and columns that will be required
    For i = LBound(originalData, 1) To UBound(originalData, 1)
    If Left(originalData(i, 1), 3) = "KEY" Then
    countKeys = countKeys + 1
    maxColumns = IIf(countColumns > maxColumns, countColumns, maxColumns)
    countColumns = 1
    Else
    countColumns = countColumns + 1
    End If
    Next i

    'Create the resulting array
    ReDim result(1 To countKeys, 1 To maxColumns) As Variant

    j = 0
    k = 1
    For i = LBound(originalData, 1) To UBound(originalData, 1)
    If Left(originalData(i, 1), 3) = "KEY" Then
    j = j + 1
    k = 1
    Else
    k = k + 1
    End If
    result(j, k) = originalData(i, 1)
    Next i

    With ActiveSheet
    .Cells(1, 2).Resize(UBound(result, 1), UBound(result, 2)) = result
    End With

    End Sub

    关于vba - Excel循环遍历列表,转置并根据单元格内容创建矩阵,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/10536611/

    29 4 0
    Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
    广告合作:1813099741@qq.com 6ren.com