VBA 资料整理

On_fire

VBA 资料整理

*

Sheet1是源资料,

每行是一组资料, 有空格, 行列是变量

*

代码逻辑如下,

1.      顺序左到右, 上到下, 将每行将数据分开两组

(  组1:格内以字符开始放A列;   

组2: 格内以数字开始放AA列,  如Sheet1(2)  )

2.       左右两组数据顺序做去空去重复

3.       右组的数字要判断前缀数值, 左到右做降序排列

( 如,

第1行:20231207 比20110103大,

第2行:20230717 比20170809大, 如此类推… )

*

模拟结果在如Sheet1(3)  

*

有点烦琐及难度,

恳请大神, 老师出手帮忙…谢谢!

fzxba

Data.zip (21.78 KB, 下载次数: 13)

2024-3-22 13:23 上传

点击文件名下载附件

liulang0808

供参考。。。。

On_fire

fzxba 发表于 2024-3-22 13:23

感谢老师出手帮忙…

On_fire

liulang0808 发表于 2024-3-22 13:39
供参考。。。。

感谢版主出手帮忙…

fzxba

On_fire 发表于 2024-3-22 15:41
感谢老师出手帮忙…

客气了，呵呵，粗心，掉了两个点
.range("A1")
.range("AA1")

On_fire

fzxba 发表于 2024-3-22 15:43
客气了，呵呵，粗心，掉了两个点
.range("A1")
.range("AA1")

好像没事的, 因为结果正常…

fzxba

On_fire 发表于 2024-3-22 15:49
好像没事的, 因为结果正常…

不严谨，还是沉不住气，浮躁。

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar(), br, i&, j&, dic(1) As New Dictionary
   
    Application.ScreenUpdating = False
   
    With Sheets(1).UsedRange
        For i = 1 To .Rows.Count
            ReDim Preserve ar(1 To i)
            ar(i) = .Rows(i)
        Next i
    End With
   
    Cells.Clear
    For i = 1 To UBound(ar)
        Erase dic
        For j = 1 To UBound(ar(i), 2)
            If Len(ar(i)(1, j)) Then
                If Len(ar(i)(1, j)) = 1 Then
                    dic(0)(ar(i)(1, j)) = Empty
                Else
                    dic(1)(ar(i)(1, j)) = Empty
                End If
            End If
        Next j
        br = dic(1).keys
        bSort1 br, 0, UBound(br), False
        Cells(i, "A").Resize(, dic(0).Count) = dic(0).keys
        Cells(i, "AA").Resize(, dic(1).Count) = br
    Next i
   
    Erase dic
    Application.ScreenUpdating = True
    Beep
End Sub

Function bSort1(ar, iFirst&, iLast&, Optional isOrder As Boolean = True)
    Dim i&, j&, vTemp
    For i = iFirst To iLast - 1
        For j = iFirst To iLast + iFirst - 1 - i
            If ar(j) <> ar(j + 1) Then
                If ar(j) < ar(j + 1) Xor isOrder Then
                    vTemp = ar(j): ar(j) = ar(j + 1): ar(j + 1) = vTemp
                End If
            End If
        Next j
    Next i
End Function

gwjkkkkk

参与一下。。。