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

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

ただいまの
回答率

90.53%

  • VBA

    1777questions

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

Collectionsの使い方がいまいち分かりません

解決済

回答 2

投稿

  • 評価
  • クリップ 0
  • VIEW 170

yuusu

score 4

Collectionsについてご教授願います。

VBAで自動的にSELECT文を作成できるようにしたいのですが、Collectionsにうまく値が追記できません
入力データはexcel表で2列のデータ

部署コード 品番コード
20 20001
10 2002
12 3001
10 4003
20 2100

出力先を一列開けた2行目からとして

SELECT * テーブル名 where bsyo = '20' AND hinban ='2001' AND hinban ='2100' order by  DESC
SELECT * テーブル名 where bsyo = '10' AND hinban ='2002' AND hinban ='4003' order by  DESC
SELECT * テーブル名 where bsyo = '22' AND hinban ='3001' order by  DESC

上のような出力にしたいです。

コード
Sub Creatsql()

    Dim srcsheet As worksheet
    Set srcsheet = Activesheet
    Dim targetRange As Range
    Set targetRange = srcsheet.usedRange.offset(1,0)
    Dim targetcell As variant
    targetcell = targetRange
    Dim maxrow As Integer
    maxrow = targetRange.row.count



    Dim hash 
    Set hash = CreateObject("Scripting.Dictionary")

    Dim x
        For x = 1 To maxrow
            Dim valueList 
            Dim key
            key = targetcell(x, 1)
            Dim value
            value = targetcell(x, 2)
               If hash.Exists(key) Then
                   Set valueList = hash.Item(key)
                valueList.Add value
            Else
                Set valueList = CreateObject("System.Collections.ArrayList")
                hash.Add key, valueList
                valueList.Add value
            End If
    Next

    Dim i
    Dim keys
    keys = hash.Keys

    Dim returnCount
    returnCount = hash.Count - 1

    Dim returnCells() 
    ReDim returnCells(returnCount)

    For i = 1 To hash.Count - 1
        Dim line
        line = "Select * テーブル名 where bsyo = '" & keys(i)& " ' " & " "
        Dim myArrayList
        Set myArrayList = hash.Item(keys(i))
        Dim ii
        Dim iMax : iMax = myArrayList.Count - 1
        For ii=1 To iMax
            line = line & " AND hinban =' " & myArrayList(ii) & " ' "& " "
        Next
        returnCells(i) = line
    Next 
    CellsToArray = returnCells
    Dim str
    For Each line In returnCells 
        str = str & line & " order by  DESC " &vbCr
    Next


End sub()

そもそもやり方が間違っていた場合は、そちらを指摘していただきたいです。
稚拙な説明文で申し訳ございませんが、よろしくお願いします。

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

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

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

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

checkベストアンサー

+1

  • まず、SQLは他の方からも指摘されてますが、これでは1件も抽出されません。常に0件です。
    hinban はOR条件にすべきです。
    where bsyo = '20' AND (hinban ='20001' OR hinban ='2100')
    これは、In演算子を使うとシンプルに記述できます。
    where bsyo = '20' AND hinban In ('20001','2100')

  • Dictionaryを使うのはいいですが、System.Collections.ArrayListを使う意味はないです。
    無意味に冗長になるだけです。

  • SQLのような長い文字列を生成するときは、 & で繋げるよりReplaceで置換するようにしたほうが、シンプルかつ読みやすいコードになります。

  • これは人によるかも知れませんが、変数を途中で宣言するのはコードを読みにくいと思います。
    コードの流れが宣言で断ち切られるので。

  • あと無駄に変数宣言が多い、一度しか使わないものはわざわざ変数に入れる必要はないでしょう。

  • 出力先が不明瞭ですが、1列空けた D2セルから下に出力することにします。

以上を考慮して、コーディングしてみました。

Sub Creatsql1()
    Const cSQL = _
    "SELECT * テーブル名 where bsyo = '%1' AND hinban In (%2) order by DESC"

    Dim targetRange As Range, outputCell As Range
    Dim i As Long
    Dim hash As Object
    Dim key, value
    Dim line As String

    Set targetRange = ActiveSheet.Range("A1").CurrentRegion.Offset(1, 0)
    Set hash = CreateObject("Scripting.Dictionary")

    For i = 1 To targetRange.Rows.Count - 1
        key = targetRange(i, 1).value
        value = "'" & targetRange(i, 2).value & "'"
        If hash.Exists(key) Then
            hash(key) = hash(key) & "," & value
        Else
            hash(key) = value
        End If
    Next

    Set outputCell = ActiveSheet.Range("D2")
    For Each key In hash
        line = Replace(cSQL, "%1", key)
        line = Replace(line, "%2", hash(key))
        outputCell.value = line
        Set outputCell = outputCell.Offset(1) '次行へ移動
    Next

End Sub

どうですか、だいぶスッキリしたでしょう。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/06/27 19:21

    ご回答ありがとうございます。
    SQLに関する指摘もありがとうございます。
    こんなにすっきりと書けるのだと勉強になりました。
    ありがとうございました。

    キャンセル

+1

SELECT * テーブル名 where bsyo = '20' AND hinban ='2001' AND hinban ='2100' order by  DESC
SELECT * テーブル名 where bsyo = '10' AND hinban ='2002' AND hinban ='4003' order by  DESC
SELECT * テーブル名 where bsyo = '22' AND hinban ='3001' order by  DESC

は、

SELECT * テーブル名 where bsyo = '20' AND ( hinban ='20001' OR hinban ='2100') order by  DESC
SELECT * テーブル名 where bsyo = '10' AND ( hinban ='2002' OR hinban ='4003') order by  DESC
SELECT * テーブル名 where bsyo = '12' AND hinban ='3001' order by  DESC

とすべきでは?

「hinban ='2001' AND hinban ='2100'」 とか、「hinban ='2002' AND hinban ='4003'」とかは、常にFALSEになるので、何も selectされません。また、部署='22'というのは入力データにありません。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/06/26 21:45

    ご回答ありがとうございます。
    SELECT文が間違っておりました。
    SELECT * テーブル名 WHERE busyo ='20' AND(hinban ='20001') AND (hinban='2100') order by DESC にしたいと思います。
    また、部署= '22'は 部署='12'の誤りでした。

    キャンセル

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

  • ただいまの回答率 90.53%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

  • 受付中

    【VBA】サブディレクトリも含めたファイル一覧を素早く取得したい

    以下のSample1とSample2はどちらもC:\Tempのサブディレクトも含めたファイル一覧を取得する関数です。 Sample1は'Sample2'よりも実行時間が短いですが、

  • 解決済

    VBAで日付の検索して表示させる

    社内ツールを作成しています。 今日の日付から計算を行い、契約終了日から決められた日数を切っている契約案件を表示させようと思っています。 例:契約終了日が2017年9月20日だとして

  • 解決済

    Excel VBA 特定範囲の重複している列に空白を設定する

    お世話になっております EXCELのVBAや関数を使用し、下記の様な表を編集したいと思っております。 置換前 グループ 項目1* 項目2 項目3 項目X 項目Y

  • 解決済

    VBA高速化について

    20個のエクセルファイルを読み込み、特定のシートにあるテーブルから特定の値を探し出し、その右横にあるセルの値を取り出します。 集計用のエクセルのテーブルでも、同じ特定の値をテーブル

  • 解決済

    powerpointでタイトル(文字列+連続変数)をVBAで一括変換

    パワーポイントで、タイトルの位置に テキスト+数字 の形でFor文を使って作りたいです。 例)こんにちは1(スライド1枚目) こんにちは2(スライド2枚目) ...といった形です。

  • 解決済

    指定範囲内のセルから数字を含まないセルを削除したい

    VBAを使ってエクセルの指定範囲内のセルから数字を含まないセルを削除したいと考えています。 具体的にはシート名”抽出”のJ列2行目から最終行までで、セル内に0~9の数字が入って

  • 解決済

    コンボボックスのリストの動的配列

     前提・実現したいこと ユーザーフォームのコンボボックスのリスト用の一覧があります。 A列が市町村、B列がそのグループです。 シート名は「一覧」です。 グループは、市町村がそのまま

  • 解決済

    【VBA】処理の高速化 について

    お世話になっています 今回はエクセルVBAに関する質問です 文字列処理がメインのコードを作成しています 以下のコードのように  判定対象文字列に文字列(例として 果物の名前)が

同じタグがついた質問を見る

  • VBA

    1777questions

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