お世話になります。関数(Vlookup)では処理(手間)に時間がかかり、マクロ(書籍やマクロの記録など)は知識不足で作る事ができませんでした。恐れ入りますが下記の内容でExcelマクロの作り方をご教示いただきたいです。マクロを勉強し始めようとしているため、全くの初心者です。お手数ですがマクロ自体の処理内容もコメント記述していただけると非常にありがたいです。

【内容】
ファイルAのA列(商品番号)をファイルBとCとDの3つのファイルから検索して合致したファイル(BかCかD)のC列とD列の値をファイルAのC列とD列へ反映したい。
ファイルB~DのC列とD列の値は、不定期に更新される。

【詳細】
(1)マクロでファイルB・C・Dを開く。

(2)ファイルAのC列とD列の空白部分へファイルB・C・DのC列とD列の値を反映。
【条件】(2)の反映をする際に、ファイルAのE列が「書籍」で、F列が「1」の場合、ファイルDのC列とD列の値を反映したい。(理由は、ファイルCとDには、同じ商品番号が存在することがあるので)

(3)あと、既に入力されているファイルAのC列とD列の値が、ファイルB~Dの
値と不一致の場合、別シートへ不一致の商品番号をリストアップしたい。
可能であれば、どの様に値が違うかも表示させたい。
表示例、本文の最下部の「不一致シート」の様な形で。

※不一致シートへ表示させるだけで、上書きをしない様にしたい。

■ファイルAのファイル名: 管理ファイル
■ファイルAのシート名: 管理シート
商品番号  商品名    棚番号 棚段数  種類  中古フラグ
G-1111  A     600  8  書籍
G-2222  B        書籍
G-3333  C     1122 書籍
G-6666  R       部品
G-8888  S       書籍
G-S9S9  000S 書籍   1
G-4444  K     6008 部品
G-YYYY  GHJK       書籍   1
G-ASDF  TT       部品
G-7K9P  MKM     5004 部品
G-4RFV  8LO       書籍   1
G-7UJM  ZXCV     1122 書籍   1
G-2525  25JJ     1193 書籍
G-VVVV  V       部品
G-CGCG  85F0     1055 部品
G-3636  S234       部品

■ファイルBのファイル名: バイク部門ファイル
■ファイルBのシート名: バイク部門シート
商品番号  商品名  棚番号  棚段数
G-4444  K   600    8
G-6666  R   100    9
G-3636  S234   112    2
G-VVVV  V
G-CGCG  P520   105    5
G-ASDF  TT
G-7K9P  MKM   500    4

■ファイルCのファイル名: 車部門ファイル
■ファイルCのシート名: 車部門シート
商品番号   商品名    棚番号 棚段数
G-1111   A      600   8
G-2222   B
G-3333   C      112   2
G-8888   S      105   5
G-2525   25JJ      119   3
G-7UJM   ZXCV
G-YYYY   GHJK      200   1

■ファイルDのファイル名: 車(トラック含)部門ファイル
■ファイルDのシート名: 車(トラック含)部門シート
商品番号   商品名    棚番号  棚段数
G-S9S9   000S 600   8
G-4RFV   8LO
G-7UJM   ZXCV 112   2
G-YYYY   GHJK 200   1

■ファイルAのファイル名: 管理ファイル
■ファイルAのシート名: 不一致シート
商品番号  棚番号(既存)  棚段数(既存) 棚番号(不一致) 棚段数(不一致)
G-????   600         8        700         3
G-???1   100         1        200         6

以上です。宜しくお願い致します

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

A 回答 (3件)

ファイルは全て同じフォルダに有るものとする。


C列とD列両方とも空白のときのみ変更する。
ファイル名は次のとおりです。
バイク部門ファイル.xls 車部門ファイル.xls 車(トラック含)部門ファイル.xls
シート名は次のとおりです。
管理 バイク部門 車部門 車トラック含部門 不一致
このマクロは、管理ファイルに書いてある。
E列が「書籍」で、F列が「1」の場合、前の値と違うときは、不一致に書き出すとともに
  C列とD列両方とも空白でないときも、管理を書き換えています。
管理ファイルの中で、商品番号のダブりは無いものとします。
管理ファイルにない商品番号はない!として処理しています。
違うときは、補足願います。

Sub 値の転記()

  Dim 配列 As Variant
  Dim 不一致(1 To 1000, 1 To 6) As Variant '不一致は1000行まで確保
  Dim i As Long, j As Long, k As Long
  Dim Gyo As Long
  Dim myDic As Object

  Set myDic = CreateObject("Scripting.Dictionary")
  With ThisWorkbook.Sheets("管理")
    配列 = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value
    For i = 1 To UBound(配列)
      myDic.Add 配列(i, 1), i
    Next
  End With
  
  On Error Resume Next
    Workbooks("バイク部門ファイル.xls").Activate
    If Err.Number <> 0 Then
      Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "バイク部門ファイル.xls"
    End If
  On Error GoTo 0
  With Workbooks("バイク部門ファイル.xls").Sheets("バイク部門")
    For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      j = myDic.Item(.Range("A" & i).Value)
      If 配列(j, 3) = "" And 配列(j, 4) = "" Then
        配列(j, 3) = .Range("C" & i).Value
        配列(j, 4) = .Range("D" & i).Value
      Else
        If 配列(j, 3) <> .Range("C" & i).Value Or _
          配列(j, 4) <> .Range("D" & i).Value Then
          Gyo = Gyo + 1
          不一致(Gyo, 1) = 配列(j, 1)
          不一致(Gyo, 2) = 配列(j, 3)
          不一致(Gyo, 3) = 配列(j, 4)
          不一致(Gyo, 4) = .Range("C" & i).Value
          不一致(Gyo, 5) = .Range("D" & i).Value
          不一致(Gyo, 6) = "バイク部門"
        End If
      End If
    Next i
  End With

以下次の回答で
    • good
    • 0

続き 3



  On Error Resume Next
    Workbooks("車(トラック含)部門ファイル.xls").Activate
    If Err.Number <> 0 Then
      Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "車(トラック含)部門ファイル.xls"
    End If
  On Error GoTo 0
  With Workbooks("車(トラック含)部門ファイル.xls").Sheets("車トラック含部門")
    For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      j = myDic.Item(.Range("A" & i).Value)
      If 配列(j, 3) = "" And 配列(j, 4) = "" Then
        配列(j, 3) = .Range("C" & i).Value
        配列(j, 4) = .Range("D" & i).Value
      Else
        If 配列(j, 3) <> .Range("C" & i).Value Or _
          配列(j, 4) <> .Range("D" & i).Value Then
          Gyo = Gyo + 1
          不一致(Gyo, 1) = 配列(j, 1)
          不一致(Gyo, 2) = 配列(j, 3)
          不一致(Gyo, 3) = 配列(j, 4)
          不一致(Gyo, 4) = .Range("C" & i).Value
          不一致(Gyo, 5) = .Range("D" & i).Value
          不一致(Gyo, 6) = "トラック含"
        End If
        If 配列(j, 5) = "書籍" And 配列(j, 6) = 1 Then
          配列(j, 3) = .Range("C" & i).Value
          配列(j, 4) = .Range("D" & i).Value
        End If
      End If
    Next i
  End With
  With ThisWorkbook
    .Sheets("管理").Range("A2", .Sheets("管理").Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value = 配列
    .Sheets("不一致").Range("A2:F1001").ClearContents
    .Sheets("不一致").Range("A2", .Sheets("不一致").Range("F" & Gyo + 1)).Value = 不一致
  End With
  
  Set myDic = Nothing
End Sub

この回答への補足

ki-aaa様

ご教示いただきありがとう御座いました。
無事、実施したい事ができました。本当に感謝致します。

ご質問させていただきたいのですが、「管理シート」の「棚番号」と「棚段数」の列を移動したくて、下記のマクロの部分で、移動先の列番号に変更しました。
しかし、「棚番号」の列には反映されましたが、「棚段数」の列は全く反映されず空白のままになります。。

※「棚番号」は、5列目(E列)へ移動し、「棚段数」は、8列目(H列)へ移動したい。
※下記マクロの箇所が3回続くので、全て列番号は変更しました。


If 配列(j, 5) = "" And 配列(j, 8) = "" Then
配列(j, 5) = .Range("C" & i).Value
配列(j, 8) = .Range("D" & i).Value
Else
If 配列(j, 5) <> .Range("C" & i).Value Or _
配列(j, 8) <> .Range("D" & i).Value Then
Gyo = Gyo + 1
不一致(Gyo, 1) = 配列(j, 1)
不一致(Gyo, 2) = 配列(j, 5)
不一致(Gyo, 3) = 配列(j, 5)
不一致(Gyo, 4) = .Range("C" & i).Value
不一致(Gyo, 5) = .Range("D" & i).Value
不一致(Gyo, 6) = "バイク部門"
End If


他の部署の依頼により今後も「棚番号」と「棚段数」の列を移動させる可能性がございます。
恐れ入りますが、移動させる場合のマクロの変更箇所と変更した箇所のマクロの意味をお教え頂けないでしょうか。

御手数おかけしており大変恐縮ですが、何卒、宜しくお願い致します。

補足日時:2011/04/17 14:55
    • good
    • 0

続き 2



  On Error Resume Next
    Workbooks("車部門ファイル.xls").Activate
    If Err.Number <> 0 Then
      Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "車部門ファイル.xls"
    End If
  On Error GoTo 0
  With Workbooks("車部門ファイル.xls").Sheets("車部門")
    For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      j = myDic.Item(.Range("A" & i).Value)
      If 配列(j, 3) = "" And 配列(j, 4) = "" Then
        配列(j, 3) = .Range("C" & i).Value
        配列(j, 4) = .Range("D" & i).Value
      Else
        If 配列(j, 3) <> .Range("C" & i).Value Or _
          配列(j, 4) <> .Range("D" & i).Value Then
          Gyo = Gyo + 1
          不一致(Gyo, 1) = 配列(j, 1)
          不一致(Gyo, 2) = 配列(j, 3)
          不一致(Gyo, 3) = 配列(j, 4)
          不一致(Gyo, 4) = .Range("C" & i).Value
          不一致(Gyo, 5) = .Range("D" & i).Value
          不一致(Gyo, 6) = "車部門"
        End If
      End If
    Next i
  End With
    • good
    • 0
この回答へのお礼

ki-aaa様

ご教授いただきありがとう御座いました。
不明点が多く戸惑ってばかりですが、
もっとマクロを勉強するように致します。

御手数おかけしました。

お礼日時:2011/05/08 22:58

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

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

このQ&Aを見た人が検索しているワード

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

Qエクセル 最大値、最小値

エクセルでの質問です。
種類  結果
A     15
A     10
B     3
C     8
C     12
C     5
D     8
の様な表から各種類の結果の最大値と最小値を取り出したいのですが、種類が1000種類程ありうまく手間がかかって出来ません。
最大値、最小値をまとめた表は、エクセルで出来ないでしょうか。よろしくお願いします。

Aベストアンサー

ピボットテーブルを使ってみたらどうでしょう。

QVBA、最小値を取得し乱数を発生し最小値と比較する

17人の生徒がいる教室で、ランダムに生徒を当てて、当たった回数を記録し、平等に当てるというVBAを教えてください。

Aベストアンサー

こんばんは。

>17人の生徒がいる教室で、ランダムに生徒を当てて、当たった回数を記録し、平等に当てる
初心者で、VBAは習ったばかりでは、これが出来るのは、10人に1人がいいところではないでしょうか?
>当方VBAの勉強を始めたばかりでして、超初心者にわかりやすく説明していただけると非常に助かります。
勉強し始めたばかりで、いきなり、このようなものに手を出すのは、無理だと思います。
なるべく簡単なコードを書いてみましたが、私は、説明するのは苦手です。関数もいくつも入っていますから、なんとなくわかるかと思います。

丸々コードを出して云々という声もないわけではないのですが、こちらもあくまでも、人のためではなく、自分のための練習です。まあ、別の掲示板の何人かは、こちらが稼働チェック済みのコードを掲示しても、動かない、エラーが出ると言って、そのまま没にしてしまうくらいの人もいるのですから、これが分かれば、それで十分だと思います。これを参考にしようがしまいが、それは自由です。ただ、初心者であろうが、そうでなかろうが、マクロの数をこなすしか、上達の道はありません。数をこなしていくなかで、覚えていくもので、理屈では、覚えるものではありません。


'//
Sub RandomAverage()
 Dim i As Long
 Dim num As Long
 Dim num2 As Long
 '初期設定
 If Range("D18").Value = "" Then
  For i = 1 To 17
   Cells(i, 1).Value = i
  Next i
  Range("D18").Formula = "=COUNT(R[-17]C:R[-1]C)"
  Range("D19").Formula = "=SUM(R[-18]C:R[-2]C)/ROWS(R[-18]C:R[-2]C)"
 End If
 
 '17番目まで全部当てたら、更新する
 num = WorksheetFunction.CountA(Range("D1:D17"))
 num2 = WorksheetFunction.Count(Range("D1:D17"))
 If Range("D18").Value Mod 17 = 0 And num2 - num = 0 Then
  If Range("E1").Value <> "" Then
   MsgBox "全部当て終わりましたので、データを移します。"
  End If
  
  For i = 1 To 17
   Cells(i, 5).Value = Cells(i, 5).Value + Cells(i, 4).Value
   Cells(i, 4).ClearContents
   num = 0
  Next i
  
  Randomize
  For i = 1 To 17
   Cells(i, 2).Value = Rnd()
   Cells(i, 3).Formula = "=RANK(RC[-1],R1C2:R17C2,1)"
  Next i
 End If
 '次の番に'N'をつける
 For i = 1 To 17
  If Cells(i, 4).Value = "N" Then
   Cells(i, 4).Value = 1
  End If
  If Cells(i, 3).Value = num + 1 Then
   Cells(i, 4).Value = "N"
  End If
 Next i
 If num2 < 16 Then
  MsgBox "Nが、次の人です。" & vbCrLf & _
  "D19の値が正数になるように目指しましょう!"
 ElseIf num = 17 Then
  MsgBox "次は、更新します。"
 End If
End Sub
'///

こんばんは。

>17人の生徒がいる教室で、ランダムに生徒を当てて、当たった回数を記録し、平等に当てる
初心者で、VBAは習ったばかりでは、これが出来るのは、10人に1人がいいところではないでしょうか?
>当方VBAの勉強を始めたばかりでして、超初心者にわかりやすく説明していただけると非常に助かります。
勉強し始めたばかりで、いきなり、このようなものに手を出すのは、無理だと思います。
なるべく簡単なコードを書いてみましたが、私は、説明するのは苦手です。関数もいくつも入っていますから、なんとな...続きを読む

Qエクセルvlookup関数で値を取得したいリストの行数が多すぎてエクセ

エクセルvlookup関数で値を取得したいリストの行数が多すぎてエクセルで表示できない
単純にa列をキーにしてb列の値を取得したいですがリストの行数が65***行以上でエクセルで開くと欠落します。リストはcsvでオープンしないで値を取得することはできますか?
宜しくお願いいたします。

Aベストアンサー

面白半分でユーザー定義関数を作成してみました。
A1に検索する値があるとして、B1に次の様に入れます。頭の1は検索する値がcsvの何列目かを示し、末尾の2は引用する列番です。
=extVlookup(1, A1, "C:\sample.csv", 2)
10万行のcsvで試験してみましたが、予想通り遅くて実用的ではないです。
'Microsoft ActiveX Data Object 2.x Libraryに参照設定要
'Schema.iniを同じフォルダーに作成しないと「抽出条件でデータ型不一致」のエラーになる事がある
'Schema.iniの内容例
'[sample.csv]
'ColNameHeader = False
'CharacterSet = OEM
'Format = CSVDelimited
'Col1=F1 Char Width 255
'Col2=F2 Char Width 255
Function extVlookup(searchColNo As Long, searchVal As Variant, fileFullPath As String, refColNo As Long) As Variant
Dim filePath As String, fileName As String
Dim strSQL As String
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim lastBackSlashPos As Long
Dim errFlag As Boolean

fileFullPath = UCase(fileFullPath)
If Right(fileFullPath, 4) <> ".CSV" Then
extVlookup = CVErr(xlErrValue)
GoTo errorHandle
End If
Set CN = New ADODB.Connection
lastBackSlashPos = InStrRev(fileFullPath, "\")
fileName = Mid(fileFullPath, lastBackSlashPos + 1, Len(fileFullPath) - lastBackSlashPos)
filePath = Left(fileFullPath, lastBackSlashPos)
CN.Provider = "Microsoft.Jet.OLEDB.4.0"
'見出し行を対象としない
CN.Properties("Extended Properties") = "Text;HDR=NO"
CN.ConnectionString = filePath
CN.Open
'Schema.iniと矛盾するとNG
If IsNumeric(searchVal) Then
strSQL = "SELECT * FROM " & fileName & _
" WHERE [" & Replace(fileName, ".CSV", "#CSV") & "].F" & CStr(searchColNo) & _
"=" & searchVal & ";"
Else
strSQL = "SELECT * FROM " & fileName & _
" WHERE [" & Replace(fileName, ".CSV", "#CSV") & "].F" & CStr(searchColNo) & _
"='" & searchVal & "'"
End If
Set RS = New ADODB.Recordset
RS.CursorLocation = adUseClient
RS.Open strSQL, CN, adOpenStatic, adLockOptimistic
If RS.RecordCount <> 1 Then
extVlookup = CVErr(xlErrValue)
GoTo errorHandle
End If
extVlookup = RS.Fields(refColNo - 1)
errorHandle:
If RS.State = 1 Then RS.Close
Set RS = Nothing
If CN.State = 1 Then CN.Close
Set CN = Nothing
End Function

面白半分でユーザー定義関数を作成してみました。
A1に検索する値があるとして、B1に次の様に入れます。頭の1は検索する値がcsvの何列目かを示し、末尾の2は引用する列番です。
=extVlookup(1, A1, "C:\sample.csv", 2)
10万行のcsvで試験してみましたが、予想通り遅くて実用的ではないです。
'Microsoft ActiveX Data Object 2.x Libraryに参照設定要
'Schema.iniを同じフォルダーに作成しないと「抽出条件でデータ型不一致」のエラーになる事がある
'Schema.iniの内容例
'[sample.csv]
'ColNameHeader = False
'...続きを読む

Qセルが空白だったらExitSub

いつもお世話になっております。
問う方Excel97でシートAのD列のデータを
シートBに自動コピーさせるVBAを思考中。
D列のデータが無くなったらLoopを止めるように
条件をつけたいのですが、どう書いたものか困っております。
ちなみに、セルの指定もコピーを書きこんだら次の行を見に行かせる為に、引数?を使用しています。
どなたか、教えて下さい。
宜しくお願い致します。

Aベストアンサー

あまりにも簡潔すぎて私には理解が難しいですが、
以下のようにすれば出来ますけど。

解説:
ループでやっているということなので、以下のようになります。
Dim lIdx as long '行ループ変数
Dim lTargetCol as long '指定列

lIdx = 1
lTargetCol = 4 'D列を指定
Do
  If Cells(lIdx, lTargetCol).value = "" Then Exit Sub

  'ココに何か処理が入ります。

  lIdx = lIdx + 1
Loop

Do~Loopのところはこうでもいいです。

Do Until Cells(lIdx, lTargetCol).value = ""

  'ココに何か処理が入ります。

  lIdx = lIdx + 1
Loop

Qエクセルの下部にデ-タ-の個数、最大値、最小値を表示させるには?

お早うございます。
エクセルの画面で、最下部(正式名所はわかりません)で右クリックすると、デ-タ-の個数、最大値、最小値等を選択できると思いますが、その表示をどの様にすれば表示する事が出来るのでしょうか?
出先のパソコンのエクセルには表示されずに困っています。
どなたか教えて頂けないでしょうか?

Aベストアンサー

ステータスバーのことですね
ステータス・バーのオートカルク値の表示部分を右クリックし、メニューから表示したい値を選択する。

Excelで関数を使わずに、素早く合計値などを確認する
http://www.atmarkit.co.jp/fwin2k/win2ktips/875autocalc/autocalc.html

Q空白セルに色をつける

B2からG6の範囲でブランクが入っていたらセルに色をつけたいのですが
下記の方法ですと「型が違います」とエラーがでます。
何がいけないのでしょうか?
ご指摘お願い致します。
ちなみにセルの書式設定ではなく今回はVBAで実行させたいのでお願い致します。

If Range("B2:G6") = "" Then

With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

End If

Aベストアンサー

n-junです。

>また下記のコードでは他ブランクも色付けされてしまいます。
>range範囲はブランクをカウントしている下記の部分なのですが
>n1/n2をひかないと本来指定したい範囲で色付けができません。
ある範囲においてセルが空白且つ”何か”の条件で色をつけるのであれば、
その”何か”を具体的にされては。

それがないと”ひかないと本来指定したい範囲”が、どこなのかわかりません。

Qワード、エクセルのページ設定の初期化の値

ワード、エクセルのページ設定の値を
初期の値にしたいので

初期の値を教えて下さい。
よろしくお願いいたします。

【ワード】
  ▼文字数宇と行数タブの
     文字数 と 字送り
     行数   と 行送り

  ▼余白タブ
     上:    mm
     下:    mm
     左:    mm
     右:    mm

【エクセル】
  ▼余白タブ
     上:
     下:
     左:
     右:
     ヘッダー:
     フッター:

Aベストアンサー

私の環境では

ワード
 文字数:40
 字送り:10.5pt
 行数:36
 行送り:18pt
 余白
  上:35mm
  下:30mm
  左:30mm
  右:30mm

エクセル
 上:2.5
 下:2.5
 左:2
 右:2
 ヘッダー:1.3
 フッター:1.3

です。



再インストールしたほうが早い場合も多いですよ。

Q最終行の空白セルに右上がり斜線を引く

B列を検索して最終行を選び、C列~G列の中から空白セルを探して、右上がり斜線を引く。


Cells(Rows.Count, 2).End(xlUp).Offset(, 1).Resize(, 5). _
Borders(xlDiagonalUp).LineStyle = xlContinuous

データーの入っているセルにも、斜線が引かれてしまいます。

空白セル(変動します)にのみ、斜線を引くことができるようにしたいのです。
よろしくお願いします。

Aベストアンサー

こんばんは!
理由はすでにNo.1さんが回答されていらっしゃる通りなので
余計なお世話かもしれませんが・・・

Sub Sample1()
Dim endRow As Long, c As Range
endRow = Cells(Rows.Count, "B").End(xlUp).Row
For Each c In Range(Cells(endRow, "C"), Cells(endRow, "G"))
If c = "" Then
c.Borders(xlDiagonalUp).LineStyle = xlContinuous
End If
Next c
End Sub

こんな感じでもOKだと思います。m(_ _)m

Qエクセルの「値の貼り付け」ボタンについて

こんにちは いつもお世話になっています。

 エクセルのテキスト形式での貼り付けについて教えてください。
ツールバーに「値の貼り付け」のボタンを作ってあります。エクセルで文字列が入ったセルをコピーして、別のセル上で「値の貼り付け」ボタンを押すと正常に効きます。
 しかし、たとえばIEで文字列をコピーしてエクセル上で「値の貼り付け」ボタンを押しても何も反応がありません。編集-「形式を選択して貼り付け」でテキスト形式を選ぶと正常にテキスト形式で貼り付けされます。
 HTMLデータではボタンが効かないということなのでしょうか。それとも、固有のトラブルでしょうか。原因、対策を教えてください。

Aベストアンサー

>それとも、固有のトラブルでしょうか。原因、対策を教えてください。

その機能の対象では無いからでしょう。
同じ事を手動で行って見てください。コピー元の違い(エクセル内部と外部)異なるダイアログボックスが表示されますよ。

対策を取るなら、コピーデータが内部か外部かを判定して貼り付けコードを変える事でしょうけど、私には判定方法が解りかねます。
他の方法としては”PutInClipboard メソッド”を使うと、クリップボードのデータをテキストに置き換える事が可能のようです。
詳細はヘルプを参考にしてください。

記録マクロでもコードが異なりますし、ヘルプの解説も「Worksheet オブジェクト」と「Range オブジェクト」に分かれます。

---------------------------------------------------------------
IE(外部データ)からの値貼り付け
ActiveSheet.PasteSpecial Format:="テキスト", Link:=False, DisplayAsIcon:= False

help:Worksheet オブジェクトの PasteSpecial メソッド
指定された形式で、クリップボードの内容をシートに貼り付けます。他のアプリケーションからデータを貼り付けるときや、あるいは特別な形式でデータを貼り付ける場合に使います。

---------------------------------------------------------------
エクセル内部の値貼り付け
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

help:Range オブジェクトの PasteSpecial メソッド
クリップボードのデータを、指定されたセル範囲に貼り付けます。

--------------------------------------------------------------

>それとも、固有のトラブルでしょうか。原因、対策を教えてください。

その機能の対象では無いからでしょう。
同じ事を手動で行って見てください。コピー元の違い(エクセル内部と外部)異なるダイアログボックスが表示されますよ。

対策を取るなら、コピーデータが内部か外部かを判定して貼り付けコードを変える事でしょうけど、私には判定方法が解りかねます。
他の方法としては”PutInClipboard メソッド”を使うと、クリップボードのデータをテキストに置き換える事が可能のようです。
詳細はヘルプを...続きを読む

Q空白セル(データ)を含むマッチングについて

はじめまして。vbaや関数などで
a列 b列..c列  ... 
01  △ 02  △ 05 △
といったexcelデータで空白の列があります。
それを重複を含む一覧よりマッチチングしたら
フラグを立てたいのです
1:nです。
関数でcontif,vbaでやってみましたがうまくいきません。
初心者ですみませんが誰がおしえていただけないでしょうか?
よろしくお願いします。

Aベストアンサー

[Sheet1]
  A  B  C  D  E ・・・ Z  AA
1 01  05     06     ・・・ 09  TRUE

[Sheet2]
  A  B  C  D  E ・・・ Z
1 01  01  01     02 ・・・
2 01  05     01     ・・・ 09
3 01  05     06     ・・・ 09
4 01  01  01     02 ・・・

の状態を想定します。

Sheet1のAA1にユーザー定義関数をセットします。式は、
AA1: =fn_HaniHikaku(A1:Z1,Sheet2!A1:Z4)

最初の解答とが違い、ユーザー定義関数で指定範囲全てを調べています。
第1引数と第2引数の列数は同じとしています。
第1引数は調べる元のセル範囲、第2引数は一覧のセル範囲。見つからなければFalseが表示されます。


下のユーザー定義関数は標準モジュールに貼り付けます。


Function fn_HaniHikaku(Rng1 As Range, Rng2 As Range)
  Dim rg As Range     '// セル
  Dim rw As Long     '// 行カウンタ
  Dim col As Integer   '// 列カウンタ
  Dim judge As Boolean  '// 判定

  For rw = 1 To Rng2.Rows.Count
    judge = True
    For col = 1 To Rng2.Columns.Count
      '// 行rwの各要素を比較する
      If Rng1.Cells(1, col) <> Rng2.Cells(rw, col) Then
        '// 一つでも違えば不一致
        judge = False
        Exit For
      End If
    Next
      '// 1行でも全要素が一致すればいい
      If judge = True Then
        Exit For
      End If
  Next
 
  '// 結果を返す
  fn_HaniHikaku = judge

End Function

[Sheet1]
  A  B  C  D  E ・・・ Z  AA
1 01  05     06     ・・・ 09  TRUE

[Sheet2]
  A  B  C  D  E ・・・ Z
1 01  01  01     02 ・・・
2 01  05     01     ・・・ 09
3 01  05     06     ・・・ 09
4 01  01  01     02 ・・・

の状態を想定します。

Sheet1のAA1にユーザー定義関数をセットします。式は、
AA1: =fn_HaniHikaku(A1:Z1,Sheet2!A1:Z4)

最初の解答とが違...続きを読む


人気Q&Aランキング

おすすめ情報