• ベストアンサー

エクセルのマクロ

任意のセル内の文字の一部をコピー状態にした後に、任意のセルに一文字ずつ貼り付けるマクロを作成したいのですが。 例えば、A1に"あいうえお"と入力されていて、"うえお"をコピー状態にして実行すると、貼り付ける基点となるセルをインプットボックスで指定し、B3が指定されたとするなら、B3に"う"、C3に"え"、D3に"お"が貼り付けられる。 以下のマクロで望んでいる処理が可能になるのですが。 Sub test()  Set x = Application.InputBox(Prompt:="test", Type:=8)   Range("A10").Select   ActiveSheet.Paste   y = Range("A10").Value   z = 0   w = Len(y)     For i = 1 To w      x.Offset(0, z).Value = Mid(y, i, 1)       z = z + 1     Next i   Range("A10").Clear End Sub 上記マクロでは、コピー状態になっている文字を一旦作業用のセルに貼り付けるという処置を取っていますが、そのように作業用のセルを用いないで同じ処理を行うにはどうすればいいでしょうか?

質問者が選んだベストアンサー

  • ベストアンサー
  • KenKen_SP
  • ベストアンサー率62% (785/1258)
回答No.4

#1 です。 参照設定が必要ですが、こっちの方が楽かな? Visual Basic Editor の[ツール]-[参照設定]で  ・Microsoft Forms 2.0 Object Library にチェックを入れておきます。下記のコードで変数 strBUF にクリップボードの内容が格納されてます。 あとは、適当にセルにバラすコードを書いて下さい。 では。 Sub Sample2()   '要参照設定: Microsoft Forms 2.0 Object Library   Dim CPB  As DataObject   Dim strBUF As String   Set CPB = New DataObject   With CPB     .GetFromClipboard     strBUF = .GetText   End With   Set CPB = Nothing   MsgBox strBUF 'クリップボードの内容を表示 End Su

laminex
質問者

お礼

ご回答ありがとうございました。 大変参考になりました。

その他の回答 (3)

回答No.3

#2です。 書き違えてしまいました。  R = Selection.Row  C = Selection.Column  For i = 1 To Len(N)   Cells(R, C + i - 1).Value = Mid(N, i, 1)  Next です。

回答No.2

作業用セルを別に作るのではなく、インプットボックスで指定されたセルそのものを 利用することもできますよね。 全体を Application.ScreenUpdating = False で画面変化を止めておいて、 ペースト後、   ActiveSheet.Paste   N = Selection.Value   C = Selection.Row   R = Selection.Column   For i = 1 To Len(N)     Cells(C, C + i - 1).Value = Mid(N, i, 1)   Next   Application.ScreenUpdating = True

laminex
質問者

お礼

ご回答ありがとうございました。 大変参考になりました。

  • KenKen_SP
  • ベストアンサー率62% (785/1258)
回答No.1

こんにちは。KenKen_SP です。 Excel で使用されている OFFICE クリップボードは VBA で直接データを取得できません。 ご提示のコードの様に一度作業用セルを経由させるしかありません。 作業用セルへの書き込みについては、   Application.ScreenUpdating = False として VBA 実行中の画面描写を停止してしまえば、ユーザーには気付かれませんが、どうしても作業用セルを使いたくないのであれば、こんな方法があります。API で直接クリップボードにアクセスしてます。 例外処理はしてませんので、適当に考えて下さい。 Option Explicit '// クリップボードを開く Private Declare Function OpenClipboard Lib "user32" ( _     ByVal hWndNewOwner As Long) As Long '// クリップボードを閉じる Private Declare Function CloseClipboard Lib "user32" () As Long '// クリップボードのデータハンドルを取得する Private Declare Function GetClipboardData Lib "user32" ( _     ByVal wFormat As Long) As Long '// ヒープに確保されたメモリをロックする Private Declare Function GlobalLock Lib "kernel32" ( _     ByVal hMEM As Long) As Long '// GlobalLock関数によってロックしたメモリのロックを外す Private Declare Function GlobalUnlock Lib "kernel32" ( _     ByVal hMEM As Long) As Long '// メモリサイズを取得する Private Declare Function GlobalSize Lib "kernel32" ( _     ByVal hMEM As Long) As Long '// 文字列のメモリポインタから文字列を取得する(読み書き用にAny型にする) Private Declare Function lstrcpy Lib "kernel32" ( _     ByVal lpString1 As Any, _     ByVal lpString2 As Any) As Long '// GetClipboardData wFormat 定数 Private Const CF_TEXT = &H1 '--------------------------------------------------------------------- ' @Procedure : CB_GetText ' @Description: クリップボードの文字列を読み込むユーザー定義関数 ' @Param   : 参照渡しの変数 strDATA に取得した文字列が格納されます ' @Return   : Boolean / 成功時:True 失敗時:False '--------------------------------------------------------------------- Private Function CB_GetText(ByRef strDATA As String) As Boolean   Dim lngHDL As Long   Dim lngMEM As Long   Dim strBUF As String   If OpenClipboard(0&) <> 0 Then     lngHDL = GetClipboardData(CF_TEXT)     If lngHDL <> 0 Then       lngMEM = GlobalLock(lngHDL)       If lngMEM <> 0 Then         strBUF = String$(GlobalSize(lngMEM), vbNullChar)         If lstrcpy(strBUF, lngMEM) <> 0 Then           CB_GetText = True         End If         Call GlobalUnlock(lngHDL)       End If     End If     Call CloseClipboard   End If   If CB_GetText Then     strDATA = Mid$(strBUF, 1, InStr(strBUF, vbNullChar) - 1)   End If End Function Sub test()      Dim x As Range   Dim y As String   Dim w As Long   Dim z As Long   Dim i As Long      'クリップボードの文字列をString型変数yに取得してみる   If CB_GetText(y) Then     '取得成功     Set x = Application.InputBox(Prompt:="セルを選択", Type:=8)     If Not x Is Nothing Then       z = 0       w = Len(y)       For i = 1 To w         x.Offset(0, z).Value = Mid$(y, i, 1)         z = z + 1       Next i     End If     Set x = Nothing   Else     '取得失敗     MsgBox "クリップボードから文字列を取得できませんでした", vbCritical   End If End Sub

laminex
質問者

お礼

ご回答ありがとうございました。 大変参考になりました。

関連するQ&A

専門家に質問してみよう