多列数据插入固定格式后合并1列

雪之花

如图所示，将A-E列数据合并转成特定格式的列，麻烦老师帮忙解答，感谢~~~
仿造论坛老师的代码，合并后引号部分不会做，感谢帮忙

GG函数

titi012

参与 一下

1. Sub tt()
   
2.     Dim Arr, Brr(), x&, y&, i%, T$
   
3.     Arr = Range("a1:e" & Cells(Rows.Count, 1).End(xlUp).Row).Value
   
4.     ReDim Brr(2 To UBound(Arr), 1 To 1)
   
5.     T = """"
   
6.     For x = 2 To UBound(Arr)
   
7.         For y = 1 To 5
   
8.             Brr(x, 1) = Arr(x, 1) & " " & Format(Arr(x, 2), "0.000") & " " & Format(Arr(x, 3), "0.000") & " 0.000 " & Format(Arr(x, 4), "0.000") & " NONE 0 0 0 0 4518 0" & T & Arr(x, 5) & T & "  " & T & T & " " & T & T
   
9.     Next y, x
   
10.     Range("L:L").ClearContents
    
11.     Range("L2").Resize(UBound(Arr) - 1, 1) = Brr
    
12. End Sub

复制代码

沈默00

加上，““”&原代码&““”，把引号当成字符写在代码里就行了

gwjkkkkk

请参考附件。。。

雪之花

gwjkkkkk 发表于 2023-12-26 17:55
请参考附件。。。

老师，你提供的代码，运行合并少了0.000，谢谢帮忙修改

雪之花

gwjkkkkk 发表于 2023-12-26 17:55
请参考附件。。。

老师，抽空帮忙修改下代码，运行结果中间少了0.000，谢谢回复

ykcbf1100

雪之花 发表于 2024-2-20 13:09
老师，抽空帮忙修改下代码，运行结果中间少了0.000，谢谢回复

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.2.20
   
2.     r = Me.Cells(Rows.Count, 1).End(3).Row
   
3.     arr = Me.Range("a1:e" & r)
   
4.     ReDim brr(1 To UBound(arr), 1 To 1)
   
5.     st1 = "NONE 0 0 0 0 4518 0"
   
6.     For i = 2 To UBound(arr)
   
7.         m = m + 1
   
8.         st = arr(i, 1)
   
9.         st = st & " " & Format(arr(i, 2), "0.000")
   
10.         st = st & " " & Format(arr(i, 3), "0.000") & " " & "0.000"
    
11.         st = st & " " & Format(arr(i, 4), "0.000")
    
12.         st = st & " " & CStr(st1)
    
13.         st = st & " " & """" & CStr(arr(i, 5)) & """"
    
14.         st = st & " " & """"""
    
15.         st = st & " " & """"""
    
16.         brr(m, 1) = st
    
17.     Next
    
18.     Me.[l13].Resize(m, 1) = brr
    
19. End Sub
    

复制代码

gwjkkkkk

雪之花 发表于 2024-2-20 13:09
老师，抽空帮忙修改下代码，运行结果中间少了0.000，谢谢回复

Option Explicit
Sub TEST1()
    Dim ar, i&, j&
   
    ar = [A1].CurrentRegion: ar(1, 1) = "合并"
    ReDim Preserve ar(1 To UBound(ar), 1 To UBound(ar, 2) + 2)
    For i = 2 To UBound(ar)
        ar(i, UBound(ar, 2)) = ar(i, 5)
        ar(i, 5) = ar(i, 4)
        ar(i, 4) = 0
        For j = 2 To 5
            ar(i, j) = Format(ar(i, j), "0.000")
        Next j
        ar(i, UBound(ar, 2)) = """" & ar(i, UBound(ar, 2)) & """ """" """""
        ar(i, UBound(ar, 2) - 1) = "NONE 0 0 0 0 4518 0"
        ar(i, 1) = Join(Application.Index(ar, i))
    Next i
   
    Columns("L").Clear
    [L4].Resize(UBound(ar)) = ar
    Beep
End Sub