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

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

ただいまの
回答率

91.25%

  • VBA

    1180questions

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

VBA 配列格納 重複を拒否

解決済

回答 4

投稿

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

King_of_Flies

score 261

お疲れ様です。

配列格納時に重複チェックを行いデータ格納を行うか、行わないかの判断をしたいです。

下記エクセルのシートがあるとします。

A列,B列,C列,D列,E列,F列,G列,H列
――――――――――――――
性別,頭,鼻,耳,目,手,口,足
男A-○,○,○,○,,,○,○
男B-○,○,○,,,○,○,○
男C-○,○,○,,,○,○,○
男D-,○,○,,,○,○,○
女A-○,,,,,,○,○
女B-○,,,,,○,○,○
女C-○,,,,,○,○,○
女D-○,,,,,○,○,○

上記のデータを男、女でまとめ、それぞれ○がついているところのORをした結果のヘッダを格納したいです。
たとえば男の場合は、B列~H列では
○,○,○,,○,○,○となるので、
配列に「頭、鼻、耳、手、口、足」を男として格納し、下記になるよう格納

Dim Hoge(1,7) As String
Hoge(0,0) = "男"
Hoge(0,1) = "頭"
Hoge(0,2) = "鼻"
Hoge(0,3) = "耳"
Hoge(0,4) = "手"
Hoge(0,5) = "口"
Hoge(0,6) = "足"
Hoge(0,7) = ""

女性の場合は

Hoge(1,0) = "女"
Hoge(1,1) = "頭"
Hoge(1,2) = "手"
Hoge(1,3) = "口"
Hoge(1,4) = "足"
Hoge(1,5) = ""
Hoge(1,6) = ""
Hoge(1,7) = ""


となるように格納します。

この時の条件として、下記のような実装をしているのですが、
コメントに記載されているような、重複データが格納されてしまうので、どのように回避すべきか悩んでおります。

Dim i As Integer
Dim j As Integer
For i = 1 To 8
  For J = 1 To 8
    If Cells(i + 1,j + 1) = "○" Then
       '配列格納処理を入れたいが、上の条件文だと、○が男A、男Bで被った場合、”頭”が二つ格納されてしまう。
    End If
  NEXT
NEXT
If Cells()

よろしくお願いいたします。

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

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

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

    クリップを取り消します

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

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

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

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

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

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

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

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

    質問の評価を下げる

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

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

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

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

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

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

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

    詳細な説明はこちら

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

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

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

回答 4

+2

重複チェックは Dictionary を使うと簡単です。
頑張ってください。

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

checkベストアンサー

+1

簡単な方法

この処理で作成した配列をその後どう使いたいかによっても変わってきそうですが、一番お手軽な方法はakabeeさんから提示されているような、配列を上書きしていく方法だと思います。

ただし、この方法では配列Hogeの要素2のインデックスに対し、設定される項目内容が固定となります。
つまり
Hoge(n, 0) :性別
Hoge(n, 1) :頭
Hoge(n, 2) :鼻
Hoge(n, 3) :耳
Hoge(n, 4) :目
Hoge(1, 5) :手
Hoge(1, 6) :口
Hoge(1, 7) :足
となります。

例えば例文の女性の場合だと、
Hoge(1,0) = "女"
Hoge(1,1) = "頭"
Hoge(1,2) = ""
Hoge(1,3) = ""
Hoge(1,4) = ""
Hoge(1,5) = "手"
Hoge(1,6) = "口"
Hoge(1,7) = "足"
というように○のない項目は間が飛ぶような結果になりますので、配列から取り出す時には値の入っているものだけ取り出すような配慮が必要です。

別案

「私ならどう書くか」という観点からの別案として、ワークシート関数COUNTIFSを利用する方法をご紹介します。

範囲全体に対して、COUNTIFSで性別と各列で○がついている行数を判断し、配列に格納します。

COUNTIFSは条件に一致するセルの数を返してくれる関数です。

1つ目の条件として、対象範囲("A2:H9")のA列から、"男"(または"女")から始まるセルを判定しています。
2つ目の条件は列ループにより変動していきますが、対象範囲のB列以降を順番に処理していき、各列毎に値が"○"のセルを判定しています。

これら2つの条件を両方満たす行の数が返されることになるので、1行でも見つかればその性別で○のついている項目ということになりますので見出し文字列を配列に格納する、という流れになっています。

この方法であれば、行単位ではループせず、列ごとに合計行数で判別を行うため、重複を考慮する必要がありません。

Sub Sample()
    Dim Hoge(1, 8) As String

    Dim iIdx1 As Integer
    Dim iIdx2 As Integer
    Dim iCol As Integer

    Dim rng As Range
    Set rng = Range("A2:H9")    '対象範囲

    'あらかじめ性別を格納
    Hoge(0, 0) = "男"
    Hoge(1, 0) = "女"

    For iIdx1 = 0 To 1  '要素1(性別)をループ
        iIdx2 = 1   '要素2のカウンタを初期化
        For iCol = 2 To 8
            'COUNTIFSでA列の性別と、対象列が○の行数をカウント。1行でも見つかれば見出し内容を配列に格納
            If Application.WorksheetFunction.CountIfs(rng.Columns(1), Hoge(iIdx1, 0) & "*", rng.Columns(iCol), "○") > 0 Then
                Hoge(iIdx1, iIdx2) = Cells(1, iCol)
                iIdx2 = iIdx2 + 1   '要素2をカウントアップ
            End If
        Next
    Next
End Sub

以上、参考になれば幸いです。

投稿

編集

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2018/01/11 15:58

    実データとフォーマットがまるきっり変更になったため、大分カスタマイズで手間取りましたが、
    jawaさんのソースを参考に上手く動作するものが作れました。

    ありがとう。

    キャンセル

+1

色々と方法はありそうですが、格納する場所が決まっているのであれば、配列にデータを「追加する」のではなく「上書きする」のではどうでしょうか。

以下のようにしてはいかがでしょう。(デバッグしていませんのであくまで参考にお願いします。)

Dim i As Integer
Dim j As Integer
Dim Hoge(1,7) As String
For i = 1 To 8
  For J = 1 To 8
    If Cells(i + 1,j + 1) = "○" Then
       '配列の列番号の位置に、1行目の列の値を格納
    'こうすれば値が重複することは無い
       Hoge(j) = Cells(1,j + 1)
    End If
  NEXT
NEXT
If Cells()

男女のデータ格納を分ける場合は格納時の直前に条件分岐等を入れれば良いかと思います。

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

+1

ループの順番を逆にしたら楽だと思います。
現状だと、男Aについて頭・鼻~、の順で見ていますが、
頭について、男A・男B~で見ると良いです。

Dim r As Integer ' 行カウンタ
Dim c As Integer ' 列カウンタ
Dim h(2) As Integer ' Hoge用カウンタ
Dim Hoge(1, 7) As String

' 要素0には男・女をあらかじめ入れておく
Hoge(0, 0) = "男"
Hoge(1, 0) = "女"

' Hoge用のカウンタを初期化
h(0) = 1
h(1) = 1

' 横方向のループ
For c = 1 To 8
    ' 男ループ
    For r = 2 To 5
        If Cells(r, c) = "○" Then
            ' 配列に追加して
            Hoge(0, h(0)) = Cells(1, c)
            ' カウンタをインクリメント
            h(0) = h(0) + 1
            ' ループは抜ける
            Exit For
        End If
    Next
    ' 女ループ
    For r = 6 To 9
        If Cells(r, c) = "○" Then
            Hoge(1, h(1)) = Cells(1, c)
            h(1) = h(1) + 1
            Exit For
        End If
    Next
Next


男女の処理をひとつにまとめようかと思いましたが、複雑になりそうだったので分けました。

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

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

ただいまの回答率

91.25%

関連した質問

  • 解決済

    VBA A,B,C…列方向へ検索値を移動したい

    お世話になっております。 下記、コードについて教えてください。 Sub 水平変位データ() Dim kensakuA As Range '検索する値 Dim

  • 解決済

    エクセルVBAの質問です

    VBA初心者です。よろしくお願いします。 以下のコードを記述しています。  Dim Rng1 As Range  Dim Rng2 As Range  Dim c As

  • 解決済

    VBA エクセル

    いつもお世話になっていおります。 うまく動かないのでご教示ねがいます。 確認用転記シート↓ 入力用シート↓ 入力シートの内容を、確認用転記シートに転記していきた

  • 解決済

    [VBA]マクロをコンパクトに短くまとめたい

    質問内容が大きく変わったので修正です。 C列には都道府県名、I列にはURLが記入されています。 以下のコードは、 「C列に"東京"とあるがI列のURLには"tokyo"と

  • 受付中

    VBAを用いてバッチファイルを作成するツール

    前提・実現したいこと 業務でVBAを用いてバッチファイルを作成するツールが必要となりました。 ActiveDirectoryのUID棚卸しの為に使用します。 添付画像のような

  • 解決済

    【VBA】入力をした順番通りに文字が反映されない

    現在業務で使うエクセルの表の分類・入力を楽にするために 「セルG12~G300orI12~I300のどれか一つに『携帯ショップスタッフor本社事務or審査事務』などの求人名を入力

  • 解決済

    VBA高速化について

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

  • 解決済

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

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

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

  • VBA

    1180questions

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