| |
▼けい さん：
おじゃまします。
>最大45列あり、少ないものは1列しか文字が入っていません。
>B列から右に向かって空白になるまで文字を連結して、A列に結果を出したい場合
列数不定なので、けっこうめんどいですね
すくなくともB列だけは全行データが入っているとして、
２例ほど。
Sub Try1()
Dim r As Range
Dim i As Long
Dim v, u
Dim t&
t = timeGetTime()
Set r = Range("B1", Cells(Rows.Count, 2).End(xlUp)).Resize(, 20)
ReDim v(1 To r.Rows.Count, 0)
For i = 1 To UBound(v)
For Each u In WorksheetFunction.Index(r.Rows(i).Value, 0#)
If IsEmpty(u) Then Exit For
v(i, 0) = v(i, 0) & u & ","
Next
v(i, 0) = Left$(v(i, 0), Len(v(i, 0)) - 1)
Next
Cells(1).Resize(r.Rows.Count).Value = v
Debug.Print "'try1", timeGetTime() - t
End Sub
Sub Try2()
Dim r As Range
Dim ss As String
Dim v, vv, i As Long
Dim t&
t = timeGetTime()
Set r = Range("B1").CurrentRegion
With Intersect(r, r.Offset(, 1))
.Copy
With GetObject("new:1C3B4210-F441-11CE-B9EA-00AA006B1A69")
.GetFromClipboard
v = Split(Replace(.GetText, vbTab, " "), vbCrLf)
End With
Application.CutCopyMode = True
ReDim vv(1 To UBound(v), 0)
For i = 0 To UBound(v) - 1
vv(i + 1, 0) = Replace(Application.Trim(v(i)), " ", ",")
Next
End With
Range("A1").Resize(i).Value = vv
Debug.Print "'try2", timeGetTime() - t
End Sub
なお、２つ目の
> With GetObject("new:1C3B4210-F441-11CE-B9EA-00AA006B1A69")
は
Microsoft Forms 2.0 Object Library に参照設定してあれば、
With New DataObject
ですみます。
もっと良い方法がありそうですが...
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
