質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VB

VB(ビジュアルベーシック)はマイクロソフトによってつくられたオブジェクト指向プログラミング言語のひとつで、同社のQuickBASICが拡張されたものです。VB6の進化版といわれています。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

3回答

1958閲覧

出力時、新しいシートが追加されるがデータが出力されない

退会済みユーザー

退会済みユーザー

総合スコア0

VB

VB(ビジュアルベーシック)はマイクロソフトによってつくられたオブジェクト指向プログラミング言語のひとつで、同社のQuickBASICが拡張されたものです。VB6の進化版といわれています。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2021/06/09 04:17

編集2022/01/12 10:55

※サンプルデータとして画像を追加しました。

以下を実現するプログラムを作りたいと考えております。
しかし、表題が原因で実現できずにいます。

【プログラムコードについての説明】
Excelから取得してきたデータを一旦、extractedDataにぶち込み、
extractedDataから条件処理をしたデータを、
連想配列と2次元配列へぶち込んでいます。
2つの配列を作っているので、
主キーと外部キーを作っています。

【extractedDataのサンプルデータ】
extractedDataのサンプルデータ

【以下コード】

VBA

1 2Sub DuplicateCalculation() 3 4Dim lineNum As Integer 5 lineNum = WorksheetFunction.CountA(Range("A4", Range("A" & Rows.Count))) 6 7 8 'データをExcelから取得 9 ReDim extractedData(1 To lineNum, 1 To 14) As Variant 10 ReDim Preserve extractedData(1 To lineNum, 1 To 14) As Variant 11 12 Dim i, j, c 13 For j = 1 To lineNum 14 c = 1 15 For i = 1 To 15 'A列~O列まで 16 If i <> 3 Then 'C列以外 17 extractedData(j, c) = Cells(j + 3, i) 18 c = c + 1 19 End If 20 Next 21 Next 22 23 24 25 26 '取得してきたデータを条件処理 27 Dim areaName As Object 28 Set areaName = CreateObject("Scripting.Dictionary") 29 Dim feeValue() As Variant 30 31 'B列とD列~O列の動的配列の入れ物作成 32 ReDim Preserve feeValue(1 To j, 1 To i) 33 34 35 k = 1 'kはキー変数 36 For j = 1 To lineNum 37 38 'キーがまだ存在してないのなら値を配列に追加/常にキー列(A列)を取得するので列固定 39 If Not areaName.Exists(extractedData(k, 1)) Then 40 'A列を配列に追加 41 '値が重複→その時のindexNumberのitemは空のままだから重複回数分をマイナス 42 areaName.Add extractedData(k, 1), k 43 44 'B列追加、D列~O列追加 45 r = 1 46 For m = 2 To 13 47 feeValue(j, r) = extractedData(k, m) 48 r = r + 1 49 Next 50 Else 51 'キーが既に存在しているならここのルートを通る 52 '売上を合算 53 For a = 1 To 12 54 'a = 2のとき、合算しないが重複データは削除 55 If a = 1 Then 56 feeValue(areaName.Count, a) = extractedData(k, a + 1) 57 Else 58 '元の位置にあるデータ+重複している行の列の値。 59 feeValue(areaName.Count, a + 1) = extractedData(areaName.Count, a + 1) + extractedData(k, a + 1) 60 End If 61 Next 62 End If 63 k = k + 1 64 Next 65 66 67 '新規シートを名前を変更してシートの最後尾に挿入 68 Dim NewWorkSheet As Worksheet 69 Set NewWorkSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count)) 70 NewWorkSheet.Name = "Sheet2" 71 72 73 'リストを出力 areaNameの値とfeeValueの値をキーで対応させて出力する 74 For j = 1 To UBound(areaName.keys) 75 For i = 1 To 14 76 NewWorkSheet.Cells(j + 4, i).Value = areaName.Item(i) 77 NewWorkSheet.Cells(j + 4, i + 1).Value = feeValue(j, i) 78 Next 79 Next 80 81 82End Sub

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

Usirow

2021/06/09 09:24

ご本人としては地続きの内容だと思うのですが、これでは「Dictionaryに値が入らない」というもともとの質問内容が消えてなくなってしまっているので、別の質問として分離した方が良くはないでしょうか。
YAmaGNZ

2021/06/10 11:49

質問が完全に変わってしまっています。 別質問として分けるべきです。
guest

回答3

0

実はこんな感じでいけるのかもしれない。

VBA

1Sub sample1() 2 3 '元シートから地域名、地域コードを取得 4 Dim ws As Worksheet, rng As Range 5 Set ws = Worksheets(1) 6 Set rng = ws.Range(ws.Range("A4"), ws.Cells(ws.Rows.Count, 1)).Resize(, 2) 7 8 '新シートに貼り付け、重複を削除 9 Dim newSheet As Worksheet 10 Set newSheet = Worksheets.Add(After:=ws) 11 rng.Copy Destination:=newSheet.Cells(1, 1) 12 newSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo 13 14 '地域名ごとに売上金額を合算する数式をセット 15 Dim wFormula 16 wFormula = Replace("=SUMIF(Sheet1!$A:$A,$A1,Sheet1!D:D)", "Sheet1", ws.Name) 17 newSheet.UsedRange.Offset(, 2).Resize(, 13).Formula = wFormula 18 19 '計算結果を値で再セット 20 newSheet.UsedRange.Value = newSheet.UsedRange.Value 21 22End Sub 23

(追記前)

VBA

1Sub sample() 2 3 Dim lineNum As Integer 4 lineNum = WorksheetFunction.CountA(Range("A4", Range("A" & Rows.Count))) 5 6 'データをExcelから取得 7 ReDim extractedData(1 To lineNum, 1 To 14) As Variant 8 ReDim Preserve extractedData(1 To lineNum, 1 To 14) As Variant 9 10 Dim i, j, c 11 For j = 1 To lineNum 12 c = 1 13 For i = 1 To 15 'A列~O列まで 14 If i <> 3 Then 'C列以外 15 extractedData(j, c) = Cells(j + 3, i) 16 c = c + 1 17 End If 18 Next 19 Next 20 21 '取得してきたデータを条件処理 22 Dim areaDic 'As Scripting.Dictionary 23 Set areaDic = CreateObject("Scripting.Dictionary") 24 25 Dim areaName, fees As Variant, dicData As Variant 26 27 For j = 1 To lineNum 28 areaName = extractedData(j, 1) 29 fees = WorksheetFunction.Index(extractedData, j, 0) 30 31 If Not areaDic.Exists(areaName) Then 32 areaDic.Add areaName, fees 33 Else 34 dicData = areaDic(areaName) 35 For i = 3 To UBound(fees) 36 fees(i) = fees(i) + dicData(i) 37 Next 38 areaDic(areaName) = fees 39 End If 40 Next 41 42 '新規シートを名前を変更してシートの最後尾に挿入 43 With Worksheets.Add(After:=Worksheets(Worksheets.Count)) 44 .Cells.Resize(areaDic.Count, 14).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(areaDic.Items)) 45 .Name = "Sheet2" 46 End With 47 48End Sub

投稿2021/06/09 09:16

編集2021/06/10 11:34
jinoji

総合スコア4585

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

vba

1 If Not areaName.Exists(extractedData(k, 1)) Then 2 'A列を配列に追加 3 '値が重複→その時のindexNumberのitemは空のままだから重複回数分をマイナス 4 areaName.Add extractedData(k - d, 1), k - d

とりあえず上記のロジックがおかしいのでは?

Not areaName.Exists(extractedData(k, 1))でキーが存在しないのを確認しているので、そのキーを追加することになるはずので、下記でいいはずです。
k - d して別のキーを追加したらすでに存在しいると怒られるのは当然です。

vba

1 If Not areaName.Exists(extractedData(k, 1)) Then 2 'キーが損斬しない→そのキーと 3 areaName.Add extractedData(k, 1), k

ざっとしか見てませんが他にもいろいろおかしいところがありそうです。


たぶん下記のようなことをしたいのかな。

A列B列は重複を排除、D列以降はA例の値が同じもので合計

vba

1Public Sub Test() 2 Dim lastLine As Integer 3 lastLine = Cells(Rows.Count, "A").End(xlUp).Row 4 5 Dim sourceData() As Variant 6 sourceData = Range("A1:O" & lastLine).Value 'データ範囲を配列に格納(C列含む) 7 8 9 Dim areaName As Object 10 Set areaName = CreateObject("Scripting.Dictionary") 11 12 Dim outoutData() 13 ReDim outoutData(1 To lastLine, 1 To 14) '出力用配列 サイズは大きめにとっておく 14 15 16 Dim r As Long, c As Long, r2 As Long 17 18 For r = 1 To UBound(sourceData) 19 If areaName.Exists(sourceData(r, 1)) Then 20 Dim r3 As Long 21 r3 = areaName(sourceData(r, 1)) 22 23 outoutData(r3, 2) = sourceData(r, 2) 24 25 '重複していたら出力配列に加算(D列以降) 26 For c = 3 To 14 27 outoutData(r3, c) = outoutData(r3, c) + sourceData(r, c + 1) 28 Next 29 Else 30 '重複していなければキー(A列の値)とアイテム(出力先行番号)を追加 31 r2 = r2 + 1 32 areaName.Add sourceData(r, 1), r2 33 34 outoutData(r2, 1) = sourceData(r, 1) 35 outoutData(r2, 2) = sourceData(r, 2) 36 For c = 3 To 14 37 outoutData(r2, c) = sourceData(r, c + 1) 38 Next 39 End If 40 Next 41 42 '新規シートを名前を変更してシートの最後尾に挿入 43 Dim NewWorkSheet As Worksheet 44 Set NewWorkSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count)) 45 NewWorkSheet.Name = "Sheet2" 46 47 NewWorkSheet.Cells(4, 2).Resize(r2, 14).Value = outoutData 48End Sub

解説

まずは、下記の点を理解しましょう。
セル範囲(Rangeオプジェクト)は Valueプロパティで配列として取得できます。
また、配列をセル範囲のValueに代入することで一気に入力できます。
コードがシンプルになるし高速化するというメリットもあります。

Office TANAKA - VBA高速化テクニック[配列を使う]

処理の流れとしては、

text

1Valueでデータ範囲を配列に格納。sourceData 2 3出力用配列は最大サイズで生成しておく。(sourceDataの行数と同じにする。) 4 5データ配列を1行目から最終行までForループで走査。 6 キーが既に存在していたら、 7   出力先配列の値にデータ配列の現在行の値を加算。 8 キーが存在しない場合は、 9  配列の1列目の値をDictionaryのキーとして追加、アイテムは出力先行番号。 10  出力先配列にデータ配列の現在行の値を転記。 11ループ終了 12 13シートを追加して、そこに出力配列をセル範囲のValueに出力。

投稿2021/06/09 05:43

編集2021/06/09 09:01
hatena19

総合スコア33620

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

退会済みユーザー

退会済みユーザー

2021/06/09 06:05

※サンプルデータとして画像を追加しました。 例えば、k=3の時、 データが重複しており、 If Not areaName.Exists(extractedData(k, 1)) Then の直下にある処理内容を通りません。 であれば、当然、 areaNameの連想配列にはk=3の時の値が入らない事になります。 ここまではわかりますか。 そうなると、Else以下の文に通る事になります。 Else以下の文で重複している時の処理を終えると、 End Ifに辿り着き、kが加算されます。 この時のkの値はk=4です。 そして、重複チェックに戻ります。 すると、k=3の時、 areaName.Add extractedData が行われていない為、空白になりえませんか。
退会済みユーザー

退会済みユーザー

2021/06/09 08:16

編集された返信内容について 試験的にそちらが作って頂いたコードを使わせて頂きました。 私がしたい事をまさに実現できておりました。 しかし、せっかくお作り頂いたのに大変恐れ入りますが 学びにならないので詳しくコードを追っておりません。 ただ、 作って頂いたコードのポイントを教えて頂きたいです。
hatena19

2021/06/09 08:25

コードの意味はコメントで説明しています。 全般的な解説を回答に追記しておきますので参照ください。
退会済みユーザー

退会済みユーザー

2021/06/10 04:23 編集

解説も含めたコードの中で、 1点だけ、質問があります。 重複分岐処理において、 重複していた場合のコードにある outoutData(r3, 2) = sourceData(r, 2) これはどの様な意図があるのでしょうか。 コードについて、 キーを渡してアイテムを返す事でその行番号を元々あったデータとして扱える。 2つの条件分岐にそれぞれ条件用の行番号変数として r2,r3を設ける事でズレなく 元々あったデータの位置を示す事ができるという発想ができませんでした… また、Rangeなどによる範囲指定で自動的に配列にかわる事は知りませんでした。 ありがとうございます
hatena19

2021/06/10 05:13

If文のコードは下記のようなことをしています。 重複していた場合 =すでに同じキーがある= areaName.Exists がTrue の時、 outoutData(r3, c) = outoutData(r3, c) + sourceData(r, c + 1) 出力先配列の各列の値にデータ配列の値を加算する(r3は出力先行番号) Else = 重複していないとき、 DictionaryオブジェクトにA列の値をキー、出力先行番号をアイテムとして追加する。 出力先配列の各列の値にデータ配列の値を代入する。
退会済みユーザー

退会済みユーザー

2021/06/10 05:23 編集

勿論、動きに関しては存じております。 私が言いたいのは動きではなくそのコードを記載した意図でして、 重複していない時はElse以下の文を通ります。 重複している時はIf直下の文を通ります。 重複している時は既にデータが挿入されているので、 outoutData(r3, 2) = sourceData(r, 2) これを記述する事で同じ値を上書き?のようなカタチになりませんか。
hatena19

2021/06/10 05:35

重複しているとき、つまり、すでにそのキーはDictionaryに存在しているので、 キーからアイテム(出力先行番号)を取得 r3 = areaName(sourceData(r, 1)) その出力先の値にsourceDataの値を加算して、上書きする。 outoutData(r3, c) = outoutData(r3, c) + sourceData(r, c + 1) 単なる上書きではなく、集計するために加算して上書きしているということです。
guest

0

エラーに関しては

A,1
B,2
C,3
A,2
D,4
とデータがあった場合、D,4のデータを処理する時(k=5)
extractedData(k, 1)DなのでDictionaryにはキーが存在しないことになります。
Aが重複しているのでdは加算され1となっているはずです。
そしてAddする時にdを引き算するとk - d = 4となりAをAddしようとします。
そうするとすでにDictionaryにはAのキーが存在しますから「このキーは既にこのコレクションの要素に割り当てられています」とエラーになります。
なぜAddする時にextractedData(k - d, 1)と重複した回数を引いているのでしょうか?

また

それとは別に空白だった値にデータを入れたいので

dという重複回数を示す変数を定義したものの、
初期値は0なので、
初めて重複したデータに出会った時は、
何の意味も持たない変数になってしまいます。

とのことですが、こちらもどのような意図があるのか私には読み取れませんでした。

例でいいので入力データと出力データがあったほうが意図が伝わりやすいかと思います。

追記

areaName.Add extractedData

が行われていない為、空白になりえませんか。

Dictionaryについて勘違いされているようです。

上記のように
A,1
B,2
C,3
A,2
とデータがあった場合、areaNameは
A,1
B,2
C,3
とAddされたデータしか格納されていませんのでk=4の時に何もAddしていない場合はareaNameは3件と変化しません。
なので空白データは存在しません。
重複したデータをただ処理したくないだけであれば

VBA

1 For j = 1 To lineNum 2 3 'キーがまだ存在してないのなら値を配列に追加/常にキー列(A列)を取得するので列固定 4 If Not areaName.Exists(extractedData(k, 1)) Then 5 'A列を配列に追加 6 '値が重複→その時のindexNumberのitemは空のままだから重複回数分をマイナス 7 areaName.Add extractedData(k , 1), k 8 9 End If 10 k = k + 1 11 Next

といった感じで処理しなければいいだけです。
(他の部分の処理に関しては見ていません)

投稿2021/06/09 05:38

編集2021/06/09 06:20
YAmaGNZ

総合スコア10222

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

退会済みユーザー

退会済みユーザー

2021/06/09 06:17 編集

質問文章を修正させて頂きました。 例えば、k=3の時、 データが重複しており、 If Not areaName.Exists(extractedData(k, 1)) Then の直下にある処理内容を通りません。 であれば、当然、 areaNameの連想配列にはk=3の時の値が入らない事になります。 そうなると、Else以下の文に通る事になります。 Else以下の文で重複している時の処理を終えると、 End Ifに辿り着き、kが加算されます。 この時のkの値はk=4です。 そして、重複チェックに戻ります。 すると、k=3の時、 areaName.Add extractedData が行われていない為、空白になりえませんか。 ちなみに、 dを用いずに出力した結果、 都道府県のみのデータがズラズラと並び、 期待した結果が得られませんでした。 また、出力時にkeyではなくitemを指定してみると 歯抜けのデータになっており、 重複時の処理の時のkの値のデータだけ抜けておりました。 この事からdという別の変数を定義する必要があると考え、 上記プログラムを作るに至りました。
退会済みユーザー

退会済みユーザー

2021/06/09 06:28

追記について Dictionaryについて、勘違いしていたようです。 ありがとうございます。 となれば、問題があるのは出力のほうですね。
YAmaGNZ

2021/06/09 06:36

多分、データを格納するfeeValueが間違っていると思います。 重複した場合にareaNameの数が変動しないのでfeeValueで格納されている場所とずれが発生するのでしょう。 feeValueに格納する時にareaName.Countを利用するといいかもしれません。
退会済みユーザー

退会済みユーザー

2021/06/09 08:10

頂いた情報をもとにコードに反映し、 私が今記載している質問文のコードを編集して反映させました。 しかしながら、 今度は全くの空白でした。 先ほどのお答えして頂いた内容について、 .Countというペア数の取得を使う、なんて私には盲点でした… ありがとうございます。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問