数据转存

可可西里.

各位老师，深夜搞数据，还请帮帮忙，非常感谢。

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.7.12
   
2.     Dim brr(1 To 1, 1 To 20)
   
3.     On Error Resume Next
   
4.     With Sheets("Sheet5")
   
5.         For i = 1 To 9
   
6.             brr(1, i) = .Cells(i, 3).Value
   
7.         Next
   
8.     End With
   
9.     With Sheets("数据表")
   
10.         r = .Cells(Rows.Count, 2).End(3).Offset(1).Row
    
11.         If r = 2 Then .Cells(r, 1) = 1 Else .Cells(r, 1) = .Cells(r - 1, 1) + 1
    
12.         .Cells(r, 2).Resize(1, 9) = brr
    
13.     End With
    
14.     MsgBox "OK！"
    
15. End Sub
    

复制代码

可可西里.

ykcbf1100 发表于 2024-7-12 07:31
参与一下。。。

解决了，得到您的帮助，解决了熬夜难题，感谢感谢

可可西里.

ykcbf1100 发表于 2024-7-12 07:31
参与一下。。。

我想简单了，现在多出好多行和列的转存需求，还请帮忙再看看实在抱歉

ykcbf1100

可可西里. 发表于 2024-7-12 17:47
我想简单了，现在多出好多行和列的转存需求，还请帮忙再看看实在抱歉

改好了。。。

ykcbf1100

更新代码。。。

1. Sub ykcbf()   '//2024.7.12
   
2.     Dim brr(1 To 1, 1 To 200)
   
3.     On Error Resume Next
   
4.     With Sheets("Sheet5")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         c = 0
   
7.         For i = 12 To r
   
8.             If .Cells(i, 1) <> Empty Then
   
9.                 c = c + 1
   
10.                 brr(1, c) = .Cells(i, 3).Value
    
11.             End If
    
12.         Next
    
13.     End With
    
14.     With Sheets("数据表")
    
15.         r = .Cells(Rows.Count, 2).End(3).Offset(1).Row
    
16.         If r = 2 Then .Cells(r, 1) = 1 Else .Cells(r, 1) = .Cells(r - 1, 1) + 1
    
17.         .Cells(r, 2).Resize(1, c) = brr
    
18.     End With
    
19.     MsgBox "OK！"
    
20. End Sub
    
21. 
    

复制代码

可可西里.

ykcbf1100 发表于 2024-7-12 18:35
改好了。。。

不对，存过去的只是币种符号，不是数据，另外存过去没有7条数据，就等于A-G 是7个不同的订单，分别对应各自的收费名称

dambcer

参与一下。。。。。。。。。。。。。。。。。。。。

可可西里.

dambcer 发表于 2024-7-12 19:47
参与一下。。。。。。。。。。。。。。。。。。。。

嗯，里面转存的数据只需要保留2位数，请帮忙再看看，感谢感谢