在宅ワークのリアルをベテランとビギナーにインタビュー>>

すでにクリップボードにあるテキストデータを、スペースを区切り文字(連続した区切り文字は1文字として扱う)として貼り付けるマクロが作りたいです。
どうか教えてください。

質問者からの補足コメント

  • A1に貼り付けたいです。
    「あい˽うえお˽˽ かきく˽ けこ
    さし すせそ」
    の場合は 、A1「あい」 B1「うえお」 C1「かきく」 D1「けこ」
    A2「さし」B2「すせそ」
    となるようにしたいです。

      補足日時:2016/08/16 19:30
  • うーん・・・

    テキストを貼り付け後、「テキストファイルウィザードを使用(U)...」というのを使っているのですが、この動作をマクロ化したいです。最初からこのように書くべきだったかもしれません。

    テキストファイルウィザードの設定は区切り文字をスペースにして、あとは添付の画像の様に設定しています。

    「[VBA][Excel]クリップボードか」の補足画像2
      補足日時:2016/08/17 11:39

このQ&Aに関連する最新のQ&A

A 回答 (9件)

こんなので、どうかな



'
'メモ帳の複数行をコピーする。
'
Sub クリップボードにあるテキストデータをスペースを区切り文字()
Dim objClip As Object
Dim pData As String


'クリップボードのセット
Set objClip = GetObject("New:1C3B4210-F441-11CE-B9EA-00AA006B1A69")
With objClip
.GetFromClipboard
pData = WorksheetFunction.Trim(.GetText)
pData = Replace(pData, " ", Chr(9))
Application.CutCopyMode = False
End With


Set objClip = GetObject("New:1C3B4210-F441-11CE-B9EA-00AA006B1A69")
With objClip
.SetText pData
.PutInClipboard
End With


Cells(1, "A").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
    • good
    • 2
この回答へのお礼

素晴らしいです!
(細かいところまではチェックしきれていませんが)完璧に望み通りの結果が得られています。

どうもありがとうございました。

お礼日時:2016/08/17 11:51

こんにちは。


#2の回答者です。

改良型と言いたいのですが、あまり複雑になると、やはりダイアログにしたほうが良いようです。ここのテキストファイルウィザードと同じようなものは私も作れるのですが、マクロの意味がなくなってしまいます。また、テキストファイルウィザードそのものを利用しても作れるのですが、一定以上のスキルがあるという自負があると、なかなかお仕着せのものは使いづらいです。記録マクロを応用すれば、簡単に出来上がります。(出てきたコードに、最後にQueryTables(1).Delete だったかな、それを加えれば、完璧のはずです)

テキストファイルウィザードの設定は、複数を使うことが可能ですが、その場合は、私は、BRegExp.dll/Basp21 というツール(公に認められています)を使います。

現状では、スペース区切りと他の区切り文字とは、多数は共存はできませんが、区切り文字を「、(読点)」「, (カンマ)」などの文字列とした場合も区切れるようにしました。安易ですが、スペースに変えるわけです。

また、Windowsの場合は、Chr(13) =CR を使って区切ってしまうと、Chr(10)=LFが、次の行の文字列に残ってしまうようですので、予め、削除することにしました。

Excelでは、数式などは、'=AB1' だと文字に入りませんので、それも加えました。ただ、経験値を活かしても、せいぜい、こんなものです。単純明快なコードのほうが最近は好まれるようですが……。

'//
Sub OutputfmrClipboardR()
 Dim CB As Object
 Dim buf As Variant, ea As Variant
 Dim arBufs As Variant
 Dim arBuf As Variant
 Dim stc As Variant
 Dim i As Long, j As Long, k As Long
 Const CLSID As String = "1C3B4210-F441-11CE-B9EA-00AA006B1A69"
 
 Set CB = CreateObject("new:" & CLSID)
 
 'Const DELIM As String = "、" '文字を区切り文字を使う場合(下も外す)
 
 On Error GoTo ErrHandler
 Range("A1").Select 'A1 を最初とする
 With CB
  .GetFromClipboard
  buf = .GetText
  If VarType(buf) = vbString Then
   'buf = Replace(buf, DELIM, Space(1), , , vbTextCompare) ''区切り文字を使う場合
   arBufs = Split(buf, Chr(13), , vbBinaryCompare)
   For Each stc In arBufs
    If Len(stc) > 0 Then
     '全角空白を半角に
     buf = Replace(stc, Space(1), Space(1), , , vbTextCompare)
     '空白は2個以上は、1つにまとめる
     Do
      buf = Replace(buf, Space(2), Space(1), , , vbTextCompare)
     Loop Until InStr(buf, Space(2)) = 0
     
     'Windows用 不要な改行コードを落とす
     buf = Replace(buf, Chr(10), "", , , vbBinaryCompare)
     arBuf = Split(buf, Space(1))
     j = UBound(arBuf)
     If j > -1 Then
      For i = 0 To j
       'Excelでは、セルの文頭に使えない文字がある
       If arBuf(i) Like "[-+=]*" Then
        ea = "'" & arBuf(i)
       Else
        ea = arBuf(i)
       End If
       '不要なバイナリコードをセルには入れない。
        ActiveCell.Offset(k, i).Value = Application.Clean(Trim(ea))
      Next i
     End If
     k = k + 1
    End If
   Next stc
  End If
 End With
ErrHandler:
 Set CB = Nothing
 If Err() <> 0 Then
  MsgBox Err.Number & " :" & Err.Description
 End If
End Sub

'//

GooUserラック様へ。
ありがとうこざいました。これで終止符を打てると思ってClipboardFormats を使おうと思いましたが、取り出すほうは、また関数が用意されていないようです。ここで、取り出すAPI関数を使おうとも考えてみましたが、ちょっと大げさ過ぎてしまいますので、やめにしました。

私は、長い間、この件は、いろんな方法を試してみて、し尽くしているつもりですから、当然、「Microsoft Forms 2.0 Object Library」の参照設定は知っているのですが、なかなか容易には使わせてもらえないような気がします。
    • good
    • 0
この回答へのお礼

こちらも完璧に動きました!ありがとうございました。

お礼日時:2016/08/17 14:58

No.6 訂正です。


違う行を削除してしまいました。
----------------------------------------------------------------------
Sub Sample2()

Dim ClipBoard As Variant
Dim RowNo As Long
Dim ColNo As Long
Dim StrNo As Long
Dim StrLen As Long
Dim StrVar As String
Dim StrCell As String

ClipBoard = Application.ClipboardFormats
If ClipBoard(1) = xlClipboardFormatText Then
ActiveSheet.Paste Destination:=Range("A1")
For RowNo = 1 To Cells(Rows.Count, 1).End(xlUp).Row
StrVar = Cells(RowNo, 1).Value
StrLen = Len(StrVar)
StrNo = 1
ColNo = 1
StrCell = ""
Do While StrNo <= StrLen
Select Case Mid(StrVar, StrNo, 1)
Case " "
If Mid(StrVar, StrNo + 1, 1) <> " " Then
Cells(RowNo, ColNo).Value = StrCell
StrCell = ""
ColNo = ColNo + 1
End If
Case Else
StrCell = StrCell & Mid(StrVar, StrNo, 1)
End Select
StrNo = StrNo + 1
Loop
If StrNo > StrLen Then Cells(RowNo, ColNo).Value = StrCell
Next
End If

End Sub
----------------------------------------------------------------------
    • good
    • 0
この回答へのお礼

コードの内容は理解できていないのですが…
動作だけみると、普通にペーストしたときとマクロでペーストしたときで結果に違いがありません…。

お礼日時:2016/08/17 11:34

もしかしたらスペースは何文字続いても1つの区切り文字として扱うと言うことですか?それならば以下のようなものでいかがでしょうか?


----------------------------------------------------------------------
Sub Sample2()

Dim ClipBoard As Variant
Dim RowNo As Long
Dim ColNo As Long
Dim StrNo As Long
Dim StrLen As Long
Dim StrVar As String
Dim StrCell As String

ClipBoard = Application.ClipboardFormats
If ClipBoard(1) = xlClipboardFormatText Then
ActiveSheet.Paste Destination:=Range("A1")
For RowNo = 1 To Cells(Rows.Count, 1).End(xlUp).Row
StrVar = Cells(RowNo, 1).Value
StrLen = Len(StrVar)
StrNo = 1
ColNo = 1
StrCell = ""
Do While StrNo <= StrLen
Select Case Mid(StrVar, StrNo, 1)
Case " "
If Mid(StrVar, StrNo + 1, 1) <> " " Then
Cells(RowNo, ColNo).Value = StrCell
StrCell = ""
End If
StrNo = StrNo + 1
Case Else
StrCell = StrCell & Mid(StrVar, StrNo, 1)
End Select
StrNo = StrNo + 1
Loop
If StrNo > StrLen Then Cells(RowNo, ColNo).Value = StrCell
Next
End If

End Sub
----------------------------------------------------------------------
これだとスペース文字を残すことが出来ませんが良いのでしょうか?
    • good
    • 1

No.3「この回答へのお礼」について


あれ?スペースが2文字続いたときはスペース1文字にして区切らないのではないのでしょうか?詳しく説明いただけないでしょうか?

No.4 WindFallerさんへ
参照設定すれば Excel2003 等でも使えます。
リストに「Microsoft Forms 2.0 Object Library」が有ればチェックを入れます。
無ければ「C:\Windows\System32\FM20.DLL」または「C:\Windows\SysWOW64\FM20.DLL」を指定します。
    • good
    • 1
この回答へのお礼

「あい(スペース)うえお(スペース)(スペース) かきく(スペース) けこ(改行)
さし(スペース)すせそ(改行)
た(スペース)(スペース)(スペース)な」
の場合は 、A1「あい」 B1「うえお」 C1「かきく」 D1「けこ」
A2「さし」B2「すせそ」
A3「た」B3「な」

といった動作を望んでいます。
pdfからコピーしたテキスト(表の形)をexcelに単純にペーストすると、A列に行すべてのテキストが貼り付けられたり、環境により列ごとに区切られることもあるのですが、意図しない空白セルが入ったりしています。
今は貼り付け後にテキスト ファイル ウィザードで、

区切り文字→スペース
連続した区切り文字は1文字として扱うにチェック

と設定しているのですが、この動作をマクロ化し、他のマクロと組み合わせたいと思っています。

お礼日時:2016/08/17 11:32

#3さんの「Application.ClipboardFormats」は知らなかったです。


ヘルプで調べました。Excel2007以上にあるものなのですね。

#2で書いた
》これ以上のもの(様々なフォーマットを扱うクリップボード)を望まれると、
》掲示板の域を超えてしまうことになると思います。

という発言は撤回させていただきます。すみませんでした。
これは、Win32 APIを想定したものです。いままで、APIで使っていたものは、今後は、そちらに切り替えてみようと思います。
また、ひとつ勉強になりました。

なお、これは、
Const CLSID As String = "1C3B4210-F441-11CE-B9EA-00AA006B1A69"

RegSeeker とOLEVIEWで、調べられます。(両方共フリーな上に、かなり役に立つツールです。)
    • good
    • 0

こんなのはいかがですか?


----------------------------------------------------------------------
Sub Sample()

Dim ClipBoard As Variant
Dim RowNo As Long
Dim ColNo As Long
Dim StrNo As Long
Dim StrLen As Long
Dim StrVar As String
Dim StrCell As String

ClipBoard = Application.ClipboardFormats
If ClipBoard(1) = xlClipboardFormatText Then
ActiveSheet.Paste Destination:=Range("A1")
For RowNo = 1 To Cells(Rows.Count, 1).End(xlUp).Row
StrVar = Cells(RowNo, 1).Value
StrLen = Len(StrVar)
StrNo = 1
ColNo = 1
StrCell = ""
Do While StrNo <= StrLen
Select Case Mid(StrVar, StrNo, 1)
Case " "
If Mid(StrVar, StrNo + 1, 1) = " " Then
StrCell = StrCell & " "
StrNo = StrNo + 1
Else
Cells(RowNo, ColNo).Value = StrCell
StrCell = ""
ColNo = ColNo + 1
End If
Case Else
StrCell = StrCell & Mid(StrVar, StrNo, 1)
End Select
StrNo = StrNo + 1
Loop
If StrNo > StrLen Then Cells(RowNo, ColNo).Value = StrCell
Next
End If

End Sub
----------------------------------------------------------------------
区切り文字は、半角スペースのみですが、以下の「" "」(3箇所)を変更したものを追加していけば増やせます。
----------------------------------------------------------------------
Case " "
If Mid(StrVar, StrNo + 1, 1) = " " Then
StrCell = StrCell & " "
StrNo = StrNo + 1
Else
Cells(RowNo, ColNo).Value = StrCell
StrCell = ""
ColNo = ColNo + 1
End If
----------------------------------------------------------------------
    • good
    • 0
この回答へのお礼

どうもありがとうございます!取りあえず動かしてみましたが、想定に近い動作をしてくれました。

唯一の問題はスペースが連続したときに区切りも連続して入ってしまう(?)点です。これはWindFaller様の回答を参考に修正できるのかなと拝察しましたので、修正に努めてみます。

お礼日時:2016/08/17 10:06

>スペースを区切り文字(連続した区切り文字は1文字として扱う)


今のところ、区切り文字は、スペース(半角・全角)になっています。
区切りは、Split を使っています。複合的な区切りなどの場合は、
正規表現Split (BRegExp) を使ったほうがよいでしょうね。

これは、ショートカットをつけると便利だと思います。
'//
Sub OutputfmrClipboard()
 Dim CB As Object
 Dim buf As Variant
 Dim arbuf As Variant
 Dim i As Long, j As Long, k As Long, n As Long
 Const CLSID As String = "1C3B4210-F441-11CE-B9EA-00AA006B1A69"
 
 Set CB = CreateObject("new:" & CLSID)
 On Error GoTo ErrHandler
 With CB
  .GetFromClipboard
  buf = .GetText
  If VarType(buf) = vbString Then
   buf = Replace(buf, Space(1), Space(1), , , vbTextCompare)
   Do
    buf = Replace(buf, Space(2), Space(1), , , vbTextCompare)
   Loop Until InStr(buf, Space(2)) = 0
   arbuf = Split(buf, Space(1))
   j = UBound(arbuf)
   If j > -1 Then
    For k = 0 To Int(j / 4)
     For i = 0 To 3
      ActiveCell.Offset(k, i).Value = Application.Clean(arbuf(n))
      n = n + 1
      If n > j Then Exit For
     Next i
    Next k
   Else
    ActiveCell.Value = Trim(arbuf)
   End If
  End If
 End With
ErrHandler:
 Set CB = Nothing
 If Err() <> 0 Then
  MsgBox Err.Number & " :" & Err.Description
 End If
End Sub

'//

とりあえず試してみてください。おかしな部分があるかもしれません。以前、同様の回答で、不満を感じる人がいたようですが、これ以上のもの(様々なフォーマットを扱うクリップボード)を望まれると、掲示板の域を超えてしまうことになると思います。

上記でClean 関数を使っています。理由は、なぜか改行コードあたりが紛れ込むようです。

簡単に行うなら、区切り位置を利用して、ダミーを使って覚えさせれば、同じようなことが可能です。
    • good
    • 0
この回答へのお礼

素晴らしいです。素早い回答もうれしかったです。

ただ、私の説明が悪かったですね。
テキストに改行があったとき次の行の1列目から貼り付けたいのです。

「あい(スペース)うえお(スペース)(スペース) かきく(スペース) けこ(改行)
さし(スペース)すせそ(改行)
た(スペース)な」
の場合は 、A1「あい」 B1「うえお」 C1「かきく」 D1「けこ」
A2「さし」B2「すせそ」
A3「た」B3「な」

といった具合です。

お礼日時:2016/08/17 09:50

どこにどのように貼り付けるのでしょうか?


たとえば
① 選択されているセルから右に向かって貼り付ける。
② 選択されているセルから下に向かって貼り付ける。
③ その他

また①だとした時に選択したセルがA1でクリップボードの内容が「あい˽うえお˽˽かきく˽けこ」の場合は 、(「˽」は空白1文字)
A1「あい」
B1「うえお˽かきく」
C1「けこ」
で良いのでしょうか?
    • good
    • 0
この回答へのお礼

ご質問ありがとうございました。
捕捉に回答を追記いたしました。分かりにくい場合はまたコメント頂ければと思います。

お礼日時:2016/08/16 19:33

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aと関連する良く見られている質問

Qクリップボードの場所を教えて下さい。

クリップボードの場所を教えて下さい。
C:\xxxx\yyyyのように教えていただけると幸いです。

Aベストアンサー

人によって異なるかも知れませんが・・・。
基本的に、systemフォルダ内のclip.exeもしくはclipbrd.exe です。

例えば、c:\Windows\System32\clip.exe
が該当しています。

QエクセルVBAでクリップボード内容をクリア

こんにちは。
エクセルのVBAの処理の中で、ある部分をコピーしてそれを、
貼り付けする処理をしています。
処理終了後、ファイルを閉じるときに、クリップボードに
コピーの内容が残っている旨のメッセージがでてきます。
このメッセージを出さない様に、クリップボードの内容を
クリアするにはどのようにすればよろしいでしょうか?
申し訳ありませんが、お教え頂きますようお願いいたします。

Aベストアンサー

Excel.Application.CutCopyMode = False
Workbooks(fName).Close savechanges:=False

かな。1行目だけでいいかも。

QExcelの終了時に「クリップボードに…」を出なくする方法

Aファイル上でBファイルを開いて、BファイルのデータをAファイルにコピーして、Bファイルを閉じるマクロ(VBA)を作っています。
しかし、Bファイルを閉じるとき「クリップボードにデータがあり、他のアプリケーションで使用する場合は…」とかいうメッセージが出ます。
他のアプリケーションで使う予定はないので、このメッセージを出さずにBファイルを閉じたいのですが、どなたかおわかりの方、教えてください。
ちなみに、マクロの最後の部分は次のようになっています。

Application.Goto Reference:=strName
Selection.Copy
Windows(strMasterName).Activate
Application.Goto Reference:=strName & strNo
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows(strFileName).Activate
Sheets(strBase).Select
ActiveWindow.Close
Windows(strMasterName).Activate

Application.ScreenUpdating = True
MsgBox "コピーが終了しました"

Aファイル上でBファイルを開いて、BファイルのデータをAファイルにコピーして、Bファイルを閉じるマクロ(VBA)を作っています。
しかし、Bファイルを閉じるとき「クリップボードにデータがあり、他のアプリケーションで使用する場合は…」とかいうメッセージが出ます。
他のアプリケーションで使う予定はないので、このメッセージを出さずにBファイルを閉じたいのですが、どなたかおわかりの方、教えてください。
ちなみに、マクロの最後の部分は次のようになっています。

Application.Goto Reference:=...続きを読む

Aベストアンサー

マクロの最後に
Application.CutCopyMode = False
を追加してみて下さい。
切り取りモードまたはコピー モードを解除し、点滅している枠線を取り除きます。

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

Qクリップボードの内容を変数に取り込みたい(EXCEL VBA)

クリップボードの内容をセルに貼らずに変数に格納する方法がありましたら、教えて頂けないでしょうか。

Aベストアンサー

こちらをどうぞ
http://www.officetanaka.net/excel/vba/tips/tips20.htm

参考URL:http://www.officetanaka.net/excel/vba/tips/tips20.htm

Qエクセルでマクロを実行中に「クリップボードに大きな情報が・・」

エクセルでマクロを実行中に「クリップボードに大きな情報があります。この情報をほかのプログラムに貼り付けるられるようにしますか?」というメッセージが表示され処理が中断されます。この表示が出ないようにしたいのですがどうしたらよいのでしょうか?

Aベストアンサー

Application.CutCopyMode = False
を宣言してみてください。

QSub ***( ) と Private Sub ***( ) の違い

初歩的な質問で申し訳ありませんが・・・

自分でコードを書いていても、イベントが発生したりした時の処理で、コードのウィンドウで上のドロップダウンリストで選択できる時の処理などは自動的に[Private Sub Command1_Click( )]などと出てくるのでそのまま使っています。自分で別途プロシージャーを作成する時は[Sub ****( )]としています。
ですがその違いを理解しないまま、自分で作成する時は[Private Sub]ではなくて[Sub]を使っています。

Sub ***( ) と Private Sub ***( ) の違いは何なんでしょうか?
どなたか説明頂けませんか?
よろしくお願いします。

Aベストアンサー

「Sub」の部分にカーソルを置いて[F1]を押せばヘルプが起動します。
「指定項目」のところに「Public」と「Private」の説明がありますよ。
省略して「Sub hogehoge()」とした場合は「Public」とみなされます。

Publicは「すべてのモジュールから呼び出せるプロシージャ」ということになります。
Privateとすると「同じモジュールの中からしか呼び出せないプロシージャ」となります。

もしExcelをお持ちでしたらExcelのVBEで標準モジュールを追加し、「Sub Test1()」と「Private Sub Test2()」を作成してみてください。
そしてExcelの[ツール]-[マクロ]-[マクロ(Alt+F8)]でマクロ実行のダイアログを表示させてみるとわかります。
ここには実行できるプロシージャの一覧が表示されますが、Test1は表示されているけれどTest2は表示されません。
Test1はPublicで、Test2はPrivateだからです。

QEXCELファイルのカレントフォルダを取得するには?

EXCELファイルのカレントフォルダを取得するには?

C:\経理\予算.xls

D:\2005年度\予算.xls

EXCEL97ファイルがあります。

VBAで
  カレントフォルダ名
(C:\経理\,D:\2005年度\)
を取得する事は可能でしょうか?

CURDIRでは上手い方法が見つかりませんでした。

Aベストアンサー

こんばんは。
Excel97 でも、同じですね。以下で試してみてください。

Sub test()
'このブックのパス
a = ThisWorkbook.Path
'アクティブブックのパス
b = ActiveWorkbook.Path
'Excelで設定されたデフォルトパス
c = Application.DefaultFilePath
'カレントディレクトリ
d = CurDir
MsgBox "このブックのパス   : " & a & Chr(13) & _
   "アクティブブックのパス: " & b & Chr(13) & _
   "デフォルトパス    : " & c & Chr(13) & _
   "カレントディレクトリ : " & d & Chr(13)
End Sub

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

Qクリップボードの内容をEXCELに貼付け

クリップボード内容をエクセルのシートに貼り付けることをvbで行おうとしています。
1回目はできるのですが、2回目にはエラーが出てしまいます。(貼り付けるセルを指定したときに)
現状のコードを添付します。おかしなところがわかる方、教えて下さい。
'-------------------------------------------------------
'エクセルを起動させる
'-------------------------------------------------------
Public Sub ExcelProc()
Dim xl2 As Excel.Application
Dim xl2Book As Object
Dim xl2Sheet As Object
Dim ELSFileName As String

'エクセルの起動
Set xl2 = CreateObject("excel.application")
xl2.Visible = True
xl2.Workbooks.Open ("d:\test.xls")
Set xl2Book = xl2.ActiveWorkbook
Set xl2Sheet = xl2Book.Worksheets(1)

'D10にクリップボードの内容を貼り付ける
xl2Sheet.Select
Range("d10").Select
ActiveSheet.Paste

'保存するファイル名を作成
ELSFileName = "c:\test10.xls"
'保存
ChDir "C:\"
ActiveWorkbook.SaveAs FileName:=ELSFileName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

Set xl2Sheet = Nothing
xl2Book.Close True
Set xl2Book = Nothing
xl2.Quit
Set xl2 = Nothing
End Sub

この関数を2度実行させたらエラーになります。
Range("d10").Select 'この箇所でエラーになる。


お願いします。

クリップボード内容をエクセルのシートに貼り付けることをvbで行おうとしています。
1回目はできるのですが、2回目にはエラーが出てしまいます。(貼り付けるセルを指定したときに)
現状のコードを添付します。おかしなところがわかる方、教えて下さい。
'-------------------------------------------------------
'エクセルを起動させる
'-------------------------------------------------------
Public Sub ExcelProc()
Dim xl2 As Excel.Application
Dim xl2Book As Object
Dim xl...続きを読む

Aベストアンサー

以下のように変更してみてください。
Active~を使用するとうまくEXCELが開放されないみたい。

'D10にクリップボードの内容を貼り付ける
xl2Sheet.Range("d10").PasteSpecial
'Range("d10").Select
'ActiveSheet.Paste
'
''保存するファイル名を作成
ELSFileName = "c:\test10.xls"
''保存
ChDir "C:\"
xl2Book.SaveAs FileName:=ELSFileName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング