问个小问题：拆份到单元格内列左右顺序怎样改变？

乐开花36

单元格内容拆份到另一工作表内，希望日期和内容从左到右顺序排列，也就是左边是最新日期，怎样改？ 资金.zip (20.31 KB, 下载次数: 4)

2018-8-1 20:19 上传

点击文件名下载附件

lsc900707

代码不是按照你的要求写好了吗？

xiangbaoan

        For k = 0 To UBound(w)
            brr(k + 1, UBound(arr) + 1 - i) = w(k) '改的在这里
        Next

乐开花36

xiangbaoan 发表于 2018-8-1 21:55
For k = 0 To UBound(w)
            brr(k + 1, UBound(arr) + 1 - i) = w(k) '改的在这里
     ...

挺好哦 ,,,高手,内容多了,怎样转弯,向下按顺序排列下去? 资金1.zip (21.77 KB, 下载次数: 2)

2018-8-2 16:11 上传

点击文件名下载附件

xiangbaoan

乐开花36 发表于 2018-8-2 16:12
挺好哦 ,,,高手,内容多了,怎样转弯,向下按顺序排列下去?

这是我的答复，行不行你自行测试，不必再这里追问了，你可发新帖解决。

1. Option Explicit
   
2. Sub test()
   
3. Application.ScreenUpdating = False
   
4. Dim lr&, ar, br, cr(), tr, x%, r&, i%, j%, y%, st$
   
5. r = 2
   
6. With Sheets("查看")
   
7.     lr = .Cells(Rows.Count, 2).End(xlUp).Row
   
8.     If lr > 2 Then
   
9.         With Sheets("资金")
   
10.             .[a:d] = ""
    
11.             .[a1] = "资金"
    
12.         End With
    
13.         If lr = 3 Then
    
14.             st = .[b3]
    
15.             tr = Split(Trim(st), ",")
    
16.             ReDim cr(10, 3)
    
17.             For x = 0 To UBound(tr)
    
18.                 cr(0, x) = x
    
19.                 cr(0, 3) = tr(x)
    
20.             Next
    
21.             cr(0, 0) = "序号"
    
22.             Sheets("资金").Cells(r, 1).Resize(11, 4) = cr
    
23.         Else
    
24.             For i = 3 To lr Step 3
    
25.                 ReDim cr(10, 3)
    
26.                 For x = 0 To UBound(cr)
    
27.                     cr(x, 0) = x
    
28.                 Next
    
29.                 cr(0, 0) = "序号"
    
30.                 j = 3
    
31.                 br = .Cells(i, 2).Resize(3)
    
32.                 For y = 1 To 3
    
33.                     st = Trim(br(y, 1))
    
34.                     If Len(st) Then
    
35.                         tr = Split(st, ",")
    
36.                         For x = 0 To UBound(tr)
    
37.                             cr(x, j) = tr(x)
    
38.                         Next
    
39.                     End If
    
40.                     j = j - 1
    
41.                 Next
    
42.                 Sheets("资金").Cells(r, 1).Resize(11, 4) = cr
    
43.                 r = r + 12
    
44.             Next
    
45.         End If
    
46.     End If
    
47. End With
    
48. Err.Clear
    
49. Application.ScreenUpdating = True
    
50. End Sub

复制代码