Question

我有以下专栏（1）：

这需要成为2列

1   
15  
150 
1500000       06700
1500000       07290
1500000       07500
2   
22  
220    
2200000       00900

我最初的想法：

创建额外列。
循环遍历行，在找到长度为7位的数字时，在变量中注册单元格和值。
将其下的值移至B列，直到值的长度为＆lt;＆gt; 5
从保存在变量中的单元格开始，将值从变量复制到A列，直到A列不再为空
在上述过程之后，循环行并删除A长度为7且B为空的位置。

由于我不熟悉VBA，在我投入之前，我想验证上面的一套规则会做我打算做的事情，如果它在技术上可行的VBA宏和更糟糕它可能导致出乎意料的行为。

此代码必须每月在新的大型Excel文件上运行。

Answer 1

记住逻辑后记住Jeeped的输入我最终按照以下方式进行：

强制将A列转换为文本
创建额外列。
获取包含数据的行数
循环1：如果A列单元格长度为5，则将单元格移动到B列
循环2：如果列A单元格长度为7，则将值复制到变量。
循环2：如果列A单元格长度为0，我们将变量粘贴到单元格
在上述过程之后，循环行并删除A长度为7且B为空的位置。（性能反向循环）

以下发布的代码的所有输入都非常受欢迎。我愿意接受各种可能的优化。

mAdapter.setSelectedList(1,3,5,7,8,9);

Answer 2

你的5位数（c / w /前导零）数字是真数字，单元格格式为00000还是文字看起来像数字Range.PrefixCharacter property，{{ 3}}应该能够从显示的文本中确定它们的修剪长度。

以下代码遵循您的逻辑步骤并进行一些修改;最明显的一个是它从A列的底部走到顶部。这是为了避免跳过已删除的行。

Sub bringOver()
    Dim rw As Long, v As Long, vVAL5s As Variant, vREV5s As Variant

    'put the cursor anywhere in here and start tapping F8
    'it will help if you can also see the worksheet with your
    'sample data

    ReDim vVAL5s(0) 'preset some space for the first value

    With Worksheets("Sheet1")   '<~~ set this worksheet reference properly!
        'ensure a blank column B
        .Columns(2).Insert

        'work from the bottom to the top when deleting rows
        'or you risk skipping a row
        For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
            'determine the length of the trimmed displayed length
            'and act accordingly
            Select Case Len(Trim(.Cells(rw, 1).Text))
                Case Is < 5
                    'do nothing
                Case 5
                    'it's one to be transferred; collect it
                    vVAL5s(UBound(vVAL5s)) = .Cells(rw, 1).Text
                    'make room for the next
                    ReDim Preserve vVAL5s(UBound(vVAL5s) + 1)
                Case 7
                    'only process the transfer if there is something to transfer
                    If CBool(UBound(vVAL5s)) Then
                        'the array was built from the bottom to the top
                        'so reverse the order in the array
                        ReDim vREV5s(UBound(vVAL5s) - 1)
                        For v = UBound(vVAL5s) - 1 To LBound(vVAL5s) Step -1
                            vREV5s(UBound(vREV5s) - v) = vVAL5s(v)
                        Next v
                        'working With Cells is like selecting htem but without selecting them
                        'want to work With a group of cells tall enough for all the collected values
                        With .Cells(rw, 1).Resize(UBound(vREV5s) + 1, 1)
                            'move over to column B and put the values in
                            .Offset(0, 1) = Application.Transpose(vREV5s)
                            'make sure they show leading zeroes
                            .Offset(0, 1).NumberFormat = "[Color13]00000;[Color9]@"
                            'if there was more than 1 moved over, FillDown the 7-wide value
                            If CBool(UBound(vREV5s)) Then .FillDown
                            'delete the last row
                            .Cells(.Rows.Count + 1, 1).EntireRow.Delete
                        End With
                        'reset the array for the next first value
                        ReDim vVAL5s(0)
                    End If
                Case Else
                    'do nothing
            End Select
            'move to the next row up and continue
        Next rw
        'covert the formatted numbers to text
        Call makeText(.Columns(2))
    End With
End Sub

Sub makeText(rng As Range)
    Dim tCell As Range
    For Each tCell In rng.SpecialCells(xlCellTypeConstants, xlNumbers)
        tCell.Value = Format(tCell.Value2, "\'00000;@")
    Next tCell
End Sub

在退出主例程之前，使用列B作为一系列单元格调用短助手子。这将循环遍历B列中的所有数字，并将数字转换为带有前导零的文本。

如代码注释中所述，请自行设置，以便您可以查看代码表以及工作表的一部分，然后开始使用F8来逐步执行代码。我试图在许多代码行上方留下的注释中添加一种运行注释的形式。

变量搜索单元格VBA

2 个答案: