Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4971 / 76807

←次へ　｜　前へ→


	【77451】Re:多量の複数セルをコピーし入れ替えして貼り付け

β - 15/10/9(金) 9:08 -


	引用なし

	パスワード

▼YUKI さん：

思い付きですが。

Private Function GetRange(adr As String) As Range
　　Dim r As Range
　　Dim w As Variant
　　Dim a As Variant
　　Dim s As String
　　w = Split(adr, ",")
　　
　　For Each a In w
　　　　If Len(s) = 0 Then
　　　　　　s = a
　　　　Else
　　　　　　If Len(s) + Len(a) > 254 Then
　　　　　　　　AddRange r, Range(s)
　　　　　　　　s = a
　　　　　　Else
　　　　　　　　s = s & "," & a
　　　　　　End If
　　　　End If
　　Next
　　
　　AddRange r, Range(s)
　　Set GetRange = r
　　
End Function

Private Sub AddRange(r As Range, c As Range)
　　If r Is Nothing Then
　　　　Set r = c
　　Else
　　　　Set r = Union(r, c)
　　End If
End Sub

こんなサブプロシジャを準備しておいて、使う際には、アドレス文字列を
何の心配もなく（？）好きなだけ長いもので指定。
サブプロシジャ内で、できるだけ少ないUnion回数でUnionして返すというやりかたも
あるかもしれませんね。

Sub Test()
　　Dim r As Range
　　Dim s As String
　　
　　s = "A1:OH4,A11:OH11,A13:OH14,A18:OH18,A25:OH25,A31:OH31,A33:OH33,A35:OH35,A61:OH61,A64:OH65,A67:OH67,A71:OH72,A84:OH84," & _
　　　　"A88:OH88,A90:OH90,A104:OH104,A107:OH108,A110:OH110,A114:OH114,A132:OH133,A151:OH151,A157:OH157,A160:OH160,A167:OH167," & _
　　　　"A175:OH175,A184:OH184,A211:OH211,A205:OH205"

　　Set r = GetRange(s)
　　
　　MsgBox r.Address
　　r.Select
　　
End Sub

MsgBoxでは長すぎる文字列の表示がし切れませんので、Selectで結果を確認してください。

2 hits

▼

【77443】多量の複数セルをコピーし入れ替えして貼り付け YUKI 15/10/7(水) 14:18