请教用VBA如何将这些数据按次序转成同一栏

MMGA

比较左边和右边

MMGA

右边是VBA跑出来的

LIUZHU

参与下，利用正则表达式匹配

LIUZHU

JSA代码

1. function 整理数据(){
   
2.         const arr=Sheets.Item("原来数据").Range("a1").CurrentRegion.Value2;
   
3.         let regex=/\w+/;
   
4.         let res=arr.reduce((res,x,i)=>{
   
5.                 x.forEach(function(y,j){
   
6.                         if (y==null) return;
   
7.                         if (!regex.test(String(y))){
   
8.                                 res.push([y,null]);
   
9.                                 return;
   
10.                         }else{
    
11.                                 if (j in this) return;
    
12.                                 res.push([x[j],x[j+1]]);
    
13.                                 [this[j], this[j+1]]=[j, j+1];
    
14.                         }
    
15.                 },{});
    
16.                 return res;
    
17.         },[]);
    
18.         Sheets.Item("想要的结果").Range("a1").Resize(res.length,res[0].length).Value2=res;
    
19. }

复制代码

LIUZHU

附件，WPS打开测试，JS宏

LIUZHU

用正则表达式匹配，把不符合规则的独立成行

MMGA

LIUZHU 发表于 2024-6-5 14:48
附件，WPS打开测试，JS宏

没有找到你的VBA宏， 能发一下吗？

longwin

Sub test()
    Dim arr As Variant
    arr = Sheets("原来数据").UsedRange
    tj = "<>[]/"
    ReDim brr(1 To UBound(arr, 1) * UBound(arr, 2), 1 To 2)
    m = 1
    n = 1
    For i = 1 To UBound(arr, 1)
        For j = 1 To UBound(arr, 2)
            If arr(i, j) <> "" Then
                brr(m, n) = arr(i, j)
                If InStr(tj, Left(arr(i, j), 1)) > 0 Then
                    n = 3
                Else
                    n = n + 1
                End If
                If n = 3 Then
                    n = 1
                    m = m + 1
                End If
            End If
        Next
    Next
    Sheets("想要的结果").[C1].Resize(UBound(brr, 1), UBound(brr, 2)) = brr
End Sub

ykcbf1100

MMGA 发表于 2024-6-5 14:39
不用删除。

没完全看明白。

MMGA

ykcbf1100 发表于 2024-6-5 15:03
没完全看明白。

两组数据，一组是数量，一组是价格。你的VBA跑出的有些数量放在了价格栏，有些价格放在了数量栏。方便的话或把全部符号删除也行。感谢！