No.9ベストアンサー
- 回答日時:
No8です。
>「実行時エラー`429`: Activexコンポーネントはオブジェクトを作成できません。」というエラーが表示され、デバックしたところ、
>「Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義」で処理がとまっているようです。
OSは何でしょうか。
もし、OSがMACの場合は、Scripting.Dictionaryをサポートしていないのでエラーになります。
もし、OSがwindows10,11等の場合は、
システム構成に問題があるケースが考えられます。
https://support.microsoft.com/ja-jp/topic/office …
いずれにしろ、Scripting.Dictionaryを使用する方法はできませんので、
逐次比較する方法に変えました。
多少、遅くなりますが(行数が非常に多いとかなり遅くなります)
以下のマクロを標準モジュールに登録してください。(前のは破棄してください)
追伸:質問時、OSがMACの場合は、予めその旨を明記したほうが良い回答が得られやすくなります。
Option Explicit
Public Sub 転記()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim row1 As Long
Dim row3 As Long
Dim i As Long
Dim key As Variant
Dim arrval() As Variant
Dim count As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Set sh3 = Worksheets("Sheet3")
maxrow1 = sh1.Cells(Rows.count, "A").End(xlUp).Row 'sheet1 A列の最大行取得
maxrow2 = sh2.Cells(Rows.count, "A").End(xlUp).Row 'sheet2 A列の最大行取得
'Sheet3クリア&見出し設定
sh3.Cells.ClearContents
sh3.Range("A1:D1").Value = sh1.Range("A1:D1").Value
sh3.Columns("D:D").NumberFormatLocal = "0%"
row3 = 2
'Sheet1を順に処理する
For row1 = 2 To maxrow1
key = sh1.Cells(row1, "B")
count = GetVals(sh2, maxrow2, key, arrval)
If count > 0 Then
For i = 1 To count
If i = 1 Then
sh3.Cells(row3, "A").Value = sh1.Cells(row1, "A").Value
End If
sh3.Cells(row3, "B").Value = sh1.Cells(row1, "B").Value
sh3.Cells(row3, "C").Value = sh1.Cells(row1, "C").Value
sh3.Cells(row3, "D").Value = arrval(i)
row3 = row3 + 1
Next
End If
Next
MsgBox ("完了")
End Sub
Private Function GetVals(ByVal sh2 As Worksheet, ByVal maxrow2 As Long, ByVal key As Variant, ByRef arrval() As Variant) As Long
Dim count As Long
Dim row2 As Long
count = 0
ReDim arrval(0)
For row2 = 2 To maxrow2
If key = sh2.Cells(row2, "C").Value Then
count = count + 1
ReDim Preserve arrval(count)
arrval(count) = sh2.Cells(row2, "D").Value
End If
Next
GetVals = count
End Function
ありがとうございます。macを使ってますが、
再度教えていただいた方法でうまく行きました。
本当に助かります‼︎お世話になりました。
No.8
- 回答日時:
補足ありがとうございました。
画像をgyazo.comにアップした場合は、そのURLを提示していただければ、回答者は、そちらを参照しますので、わざわざこちらに再掲載しなくても構いません。(その方が手間がかからないかと思います)
Sheet1とSheet2の内容を参照し、Sheet3に出力するようにしています。
(Sheet1の内容は変更されません)
空のSheet3を作成してから、マクロを実行してください。
尚、Sheet1の顧客コードが、Sheet2に存在しない場合は、その顧客コードは転記されません。
以下のマクロを標準モジュールに登録してください。
Option Explicit
Public Sub 転記()
Dim dicT As Object
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim row1 As Long
Dim row2 As Long
Dim row3 As Long
Dim i As Long
Dim key As Variant
Dim ArrList As Object 'ArrayList
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Set sh3 = Worksheets("Sheet3")
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
maxrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row 'sheet1 A列の最大行取得
maxrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row 'sheet2 A列の最大行取得
'Sheet2読み込み
For row2 = 2 To maxrow2
key = sh2.Cells(row2, "C").Value
If dicT.exists(key) = False Then
Set ArrList = CreateObject("System.Collections.ArrayList")
dicT.Add key, ArrList
End If
dicT(key).Add row2
Next
'Sheet3クリア&見出し設定
sh3.Cells.ClearContents
sh3.Range("A1:D1").Value = sh1.Range("A1:D1").Value
sh3.Columns("D:D").NumberFormatLocal = "0%"
row3 = 2
'Sheet1を順に処理する
For row1 = 2 To maxrow1
key = sh1.Cells(row1, "B")
If dicT.exists(key) = True Then
For i = 0 To dicT(key).Count - 1
If i = 0 Then
sh3.Cells(row3, "A").Value = sh1.Cells(row1, "A").Value
End If
row2 = dicT(key)(i)
sh3.Cells(row3, "B").Value = sh1.Cells(row1, "B").Value
sh3.Cells(row3, "C").Value = sh1.Cells(row1, "C").Value
sh3.Cells(row3, "D").Value = sh2.Cells(row2, "D").Value
row3 = row3 + 1
Next
End If
Next
MsgBox ("完了")
End Sub
回答いただき、ありがとうございます。
教えていただいたマクロを標準モジュールに入れてみましたが、
「実行時エラー`429`: Activexコンポーネントはオブジェクトを作成できません。」というエラーが表示され、デバックしたところ、
「Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義」で
処理がとまっているようです。どのように対処したらよいか教えていただけますでしょうか。
No.7
- 回答日時:
でしたら、この方法で良いですね。
ループ1の中に、ループ2を入れます。
ループ1:表1で回す
ループ2:表2で回す
表1の顧客コードと表2の顧客コードが一致したら、表3に転記する
ループの方法は、こちらが参考になると思います。
https://tonari-it.com/do-while-loop/
No.4
- 回答日時:
全く意味が分かりません。
もっと具体的に表してください。
この表もいらないところばかりで大切なところが小さく全く理解できない。
表をデスクトップに転機しても全くわからない。
もっと真面目に質問して!
No.2
- 回答日時:
gyazo.comを利用すると、鮮明な画像がアップ可能です。
下記URLはそのサンプルです。(画像の内容は質問とは関係ありません)
https://gyazo.com/b48931500b83bbf543391a973080a5ad
gyazo.comへアップされてみてはいかがでしょうか。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excel(エクセル)でフィルター抽出後、非表示の行を計算しないで、合計を算出する方法 【内容】 添 4 2023/01/30 17:17
- Excel(エクセル) 【Excelの集計について質問です。】 7 2022/12/03 16:51
- C言語・C++・C# C言語初心者 構造体 課題について 1 2023/03/10 19:30
- Excel(エクセル) Excelの数式についての質問 1 2022/10/31 15:50
- Excel(エクセル) Excelの担当者割当の表から担当者を抽出する方法 4 2022/07/16 14:05
- Excel(エクセル) Excelにて、行の最後のセルの値をコピーして別sheetに張りつけるVBAコードをご教授願います 3 2022/11/20 14:35
- Excel(エクセル) エクセルでSUMIFS関数で条件範囲の部分が#valueになる。 4 2023/04/28 12:42
- Excel(エクセル) 重複データの抽出について 2 2023/07/21 14:52
- Excel(エクセル) 【Excel質問】別シートにある複数の同型の表から、同じ行項目にある数字を集計する 4 2023/02/16 00:14
- Excel(エクセル) エクセル 条件に合う日付に入力された時間数の合計したい 4 2022/06/17 22:18
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
首吊りどこ締めるの
-
至急!尿検査前日にオナニーし...
-
尿検査前日に自慰行為した時の...
-
白血球が多いとどんな心配があ...
-
尿検査の前日は自慰控えたほう...
-
検便についてです。 便は取れた...
-
彼女のことが好きすぎて彼女の...
-
勃起する時って痛いんですか? ...
-
EXCELで条件付き書式で空白セル...
-
腕を見たら黄色くなってる部分...
-
EXCELで式からグラフを描くには?
-
変な話しになります。尿検査で...
-
excelでsin二乗のやり方を教え...
-
エクセル指定した範囲からラン...
-
Excelで""で囲む方法
-
ある範囲のセルから任意の値を...
-
2つの数値のうち、数値が小さい...
-
精子が黄色?
-
エクセルでエラーが出て困って...
-
納豆食べた後の尿の納豆臭は何故?
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
至急!尿検査前日にオナニーし...
-
首吊りどこ締めるの
-
尿検査の前日は自慰控えたほう...
-
尿検査前日に自慰行為した時の...
-
検便についてです。 便は取れた...
-
白血球が多いとどんな心配があ...
-
中出しをするとお腹が痛い・・・。
-
射精をして1週間以内に尿検査を...
-
彼女のことが好きすぎて彼女の...
-
腕を見たら黄色くなってる部分...
-
勃起する時って痛いんですか? ...
-
変な話しになります。尿検査で...
-
これって喉仏ですか? 私は女性...
-
EXCELで条件付き書式で空白セル...
-
男です。昨日の午後3時くらいに...
-
今朝、毎朝の習慣でオナニーし...
-
納豆食べた後の尿の納豆臭は何故?
-
1日前の検尿
-
値が入っているときだけ計算結...
-
精子が黄色?
おすすめ情報
皆さんコメントありがとうございます。
大変わかりにくいご質問で申し訳ありませんでした。
tatsumaru77 さんからアドバイスで、gyazo.comを利用し、
再度画像を拡大の上、添付いたしましたので、ご確認いただければと思います。
やりたいことは、表1と表2の顧客コードに一致しているときに、表2の率を表1の率に
転記したいです。顧客コードと率は1体1の関係ではなく、1体複数の関係になっているので、
うまく転記できずに困っています。
たとえば、111112は率が3%と10%の2つデータがあるため、表2から表1に率を転記する際、
データを2行ににわけて転記したいです。
という転記を繰り返して、表3のような表を完成させていたいです。
お手数をおかけいたしますが、よろしくお願いします。