1504648298 クリップボードにある言葉を特定のセルに貼り付けたい。


エクセルに、画像のような一例の表があるとします。なお、列の項目はもっとありますし、項目は仮です。

クリップボードに、
[2017/9/8]
[目標]売上達成
[イベント]部長来店
[反省]部長が来たときに接客おろそかになった。

などとあったら、エクセルの該当日付の行に、それぞれ[]の後の言葉を貼り付け(値のみ)てもらいたいのです。クリップボード内の項目には必ず[ ]があるものとします。(表にはない)貼り付けるときに、[]の改行があるますべてを貼りけるものとします。

エクセルのマクロの方のみポイントをお渡しします。
どうかよろしくお願いいたします。

回答の条件
  • 1人1回まで
  • 13歳以上
  • 登録:2017/09/06 06:51:38
  • 終了:2017/09/07 22:11:13

ベストアンサー

id:a-kuma3 No.1

a-kuma3回答回数4605ベストアンサー獲得回数19432017/09/07 10:51:51

ポイント300pt

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

'   クリップボードのデータを、行単位の配列で返す
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 = CreateObject("VBScript.RegExp")
    re.Pattern = "\[([^\]]+)\](.*)"
    Set m = re.Execute(Data(1))
    If m.Count = 0 Then
        Exit Sub
    End If
    report_date = m(0).submatches(0)

    '   日付の行を探す
    last_row = Cells(Rows.Count, 1).End(xlUp).Row
    target_row = -1
    For r = 2 To last_row
        If Cells(r, 1).Text = report_date Then
            target_row = r
            Exit For
        End If
    Next
    If target_row = -1 Then
        Exit Sub
    End If

    '   行タイトルと列の対応表を作る
    Set column_map = CreateObject("Scripting.Dictionary")
    last_col = Cells(1, Columns.Count).End(xlToLeft).Column
    For c = 2 To last_col
        column_map.Add Cells(1, c).Value, c
    Next

    '   日付以外のデータをシートに埋め込む
    For i = 2 To UBound(Data)
        Set m = re.Execute(Data(i))
        If m.Count > 0 Then
            k = m(0).submatches(0)
            v = m(0).submatches(1)
            If column_map.exists(k) Then
                Cells(target_row, column_map.Item(k)).Value = v
            End If
        End If
    Next
End Sub

set_data サブルーチンを、該当のシートを選択した状態で実行です。

クリップボードからデータを取得するところが関数になってるのは、前の質問id:ken3memo さんが Microsoft Forms を使う回答をしていたので、そちらの方がお好みなら、この関数の部分を差し替えてください、ということで。

他2件のコメントを見る
id:a-kuma3

シートの一行目で、重複しているものがあるのだと思います。
その重複している項目は、クリップボードから貼り付けるデータには含まれないのであれば、無視するようにしますが。

2017/09/07 20:14:46
id:naranara19

いえいえ、ありがとうございました。確かにご指摘通り、私のミスで重複がありました。
感謝感謝です。お忙しい中リクエストにお応えいただき、本当に感謝しております。
今後ともよろしくお願いいたします。

2017/09/07 22:10:45

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません