人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

【エクセルVBAマクロ】クリップボードからの各セルへの貼付


クリップボードの中に、下記のような書式があります。
これをいま選択中のセルから真下に向かって切り取って貼り付けていってほしいのです。

★詳しくは画像をご確認ください。

クリップボード内
---

0927?など日付からはじまる文字列(0もそのまま)
言葉?
httpから始まるURL



1001?など日付からはじまる文字列(0もそのまま)
言葉?
httpから始まるURL

1215?など日付からはじまる文字列(0もそのまま)
言葉?
httpから始まるURL


ずっと同じような繰り返し

---
いずれも4桁の数字からはじまり、URLで終わります。
その3行がワンセットで、そのワンセットずつの間の改行数は3行だったり、1行だったり一定しません。

URLを目印にしていただくと良いかもしれません。


マクロを実行すると、選択しているセルに一番初めの3行分が貼り付けられ、すぐ真下のセルに、次の3行分が貼り付けられます。その真下に3つ目の3行が貼り付いていくという感じです。3行のまとまりがなくなったら、マクロが止まります。


★マクロでのご回答のみ、ポイント対象となります。
どうかよろしくお願いいたします。

1506595275
●拡大する

●質問者: naranara19
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● a-kuma3
●300ポイント ベストアンサー

こんな感じでどうでしょう。

Function get_clipboard_data() As Variant
 Dim ret()
 Dim temp_sheet, target_sheet
 Set target_sheet = ActiveSheet
 Set temp_sheet = Worksheets.Add
 temp_sheet.Paste Range("a1")
 last_row = Cells(Rows.Count, 1).End(xlUp).Row
 ReDim ret(last_row)
 For r = 1 To last_row
 ret(r) = Cells(r, 1).Value
 Next
 get_clipboard_data = ret
 Application.DisplayAlerts = False
 temp_sheet.Delete
 Application.DisplayAlerts = True
 target_sheet.Activate
End Function

Sub set_data()
  ' クリップボードのデータを取得
 Data = get_clipboard_data()

 Set re_date = CreateObject("VBScript.RegExp")
 re_date.Pattern = "^[01][0-9][0-3][0-9]"
 Set re_url = CreateObject("VBScript.RegExp")
 re_url.Pattern = "^https?://"

 r = Selection.Row
 c = Selection.Column
 For i = 1 To UBound(Data)
 If re_url.test(Data(i)) Then
 If i >= 3 And re_date.test(Data(i - 2)) Then
 Cells(r, c).Value = Data(i - 2) & vbLf & Data(i - 1) & vbLf & Data(i)
 r = r + 1
 End If
 End If
 Next
End Sub

set_data サブルーチンを実行してください。
イレギュラーなデータのことをどこまで考えるか、ということはありますが、

を繰り返してます。
1セットの 3行が空業で区切られていなくても、ひとつのデータと見なします。

クリップボードからのデータの取得は、以前の質問のときのように、作業用のシートにいったん貼り付けてセルの値を抜き出しています。


naranara19さんのコメント
いつもありがとうございます!毎度ながら完璧でした。心より、感謝いたします。
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ