[[20140821111405]] 『同じ名称が有れば文字を結合』(獣毓) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『同じ名称が有れば文字を結合』(獣毓)

 いつも楽しく勉強させて頂いております。  

 F列が同じ物が有れば、B列の番号を結合してダブっていた番号は削除して表示出来る様に出来ますでしょうか?
 縦行は最大50位です。
 幾つか参考になる物が有ればと検索しましたが、見つかりませんでしたので質問させて頂きます。
 VBAでしか出来ない様と思いますので教えて頂けませんでしょうか?宜しくお願い致します。

	A		B		C		D		E	       F	

 2		      14232								りんご農園
 3		      14233								みかん市場
 4		      14238								メロン農家
 5		      15000								りんご農園
 6		      15002								みかん市場
 7	              15003								りんご農園
 .
 .
 50

 下記の様に表示変更したい。

	A		B		C		D		E	       F	

 2		14232・15000・15003							りんご農園
 3		14233・15002								みかん市場
 4		14238									メロン農家

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 回答ではないですが。

 表示用のセルに結合して表示、ではなく、元のデータ自体を
 書き換えたい、ということでしょうか?

 元のデータは残して表示用のセルに結合して表示、としたほうが
 いいように思います。
 後でやっぱり分割したい、というときが大変です。
(カリーニン) 2014/08/21(木) 11:27

 そうです。元のデータは必要有りませんので、データーを書き換えたいです。
 あとで分割したいと言う事も有りません。現行アナログで手動で変更している状況です。
 宜しくお願い致します。
(獣毓) 2014/08/21(木) 11:33

 一行目に列項目がセットされていると想定。

 Sub test()
    Dim a, i As Long, ii As Long, n As Long
    With Cells(1).CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            For i = 1 To UBound(a, 1)
                If Not .exists(a(i, 6)) Then
                    n = n + 1: .Item(a(i, 6)) = n
                    For ii = 1 To UBound(a, 2)
                        a(n, ii) = a(i, ii)
                    Next
                Else
                    a(.Item(a(i, 6)), 2) = _
                    a(.Item(a(i, 6)), 2) & "・" & a(i, 2)
                End If
            Next
        End With
        .ClearContents
        .Resize(n).Value = a
    End With
End Sub
(seiya) 2014/08/21(木) 11:59

 seiya様
 有難う御座います。
 希望通りのコード教えて頂きまして助かりました。
 もう少し教えてほしいのですが、n = n + 1: .Item(a(i, 6)) = nの意味を教えて頂けませんでしょうか。
 今後の勉強の為に。
 あと a(n, ii) = a(i, ii)のiiも教えて下さい。
 宜しくお願い致します。
(獣毓) 2014/08/21(木) 13:06

 まず、Local Window を表示させ Step Debug して

 配列変数 a の中身が変化するのを確認してください。

 その後尚不明な点があれば、質問してください。
(seiya) 2014/08/21(木) 14:46

 seiya様回答有難う御座います。
 今更ながらですが、
 B8に15004 F8が空白
 B9に15005 F8も空白の場合
 15004・15005と処理されるのですが、F列が空白の場合は結合せずにすると言う事は 出来ますでしょうか?
 こちらのミスで、F列ではなくG列で教えて頂きましたコード(i,6)の箇所を単純に(i,7)に変更致しますと
 If Not .exists(a(i, 6)) Then インデックス有効範囲ではありませんとデバックエラーが表示されます。
 度々で申し訳有りませんがもう少し教えて下さい
  宜しくお願い致します。
  
(獣毓) 2014/08/21(木) 15:27

 >インデックス有効範囲ではありませんとデバックエラーが表示されます。
 処理対象範囲に空白列が含まれていますか?

 もう一度、正確なデータレイアウトを列項目も入れてアップしてください。

       A		B		C		D		E	       F               G	
 2		      14232								             りんご農園
 3		      14233								             みかん市場
 4		      14238								             メロン農家
 5		      15000								             りんご農園
 6		      15002								             みかん市場
 7	              15003								             りんご農園
 .
 50
 D〜F列は、常時空白の設定です。
 インデックス有効範囲に有りませんとエラー表示
 エラー行は、
 Sub Test()

    Dim a, i As Long, ii As Long, n As Long
    With Cells(1).CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            For i = 1 To UBound(a, 1)
                If Not .exists(a(i, 7)) Then     ←ここでエラーが出ます
                    n = n + 1: .Item(a(i, 7)) = n
                    For ii = 1 To UBound(a, 2)
                        a(n, ii) = a(i, ii)
                    Next
                Else
                    a(.Item(a(i, 7)), 2) = _
                    a(.Item(a(i, 7)), 2) & "・" & a(i, 2)
                End If
            Next
        End With
        .ClearContents
        .Resize(n).Value = a
    End With
 End Sub
 宜しくお願い致します。


 こういうことですか?

  Sub test()
    Dim a, i As Long, ii As Long, n As Long
    With ActiveSheet
        With Range("a1", .Cells.SpecialCells(11)).Resize(, 7)
            a = .Value
            With CreateObject("Scripting.Dictionary")
                For i = 1 To UBound(a, 1)
                    If a(i, 7) <> "" Then
                        If Not .exists(a(i, 7)) Then
                            n = n + 1: .Item(a(i, 7)) = n
                            For ii = 1 To UBound(a, 2)
                                a(n, ii) = a(i, ii)
                            Next
                        Else
                            a(.Item(a(i, 7)), 2) = _
                            a(.Item(a(i, 7)), 2) & "・" & a(i, 2)
                        End If
                    End If
                Next
            End With
            .ClearContents
            .Resize(n).Value = a
        End With
    End With
End Sub

(seiya) 2014/08/21(木) 17:13


答えじゃありませんが、インデックス有効範囲に有りませんとエラー表示
を実際にだしてみましたが、おそらくD E F の1行目も空白ですか、
D E F G の1行目に文字や数字がないとこのエラーがでました。
上記のseiyaさんのVBAでは大丈夫でしたので、お試しください。
後今のseiyaさんのVBAで行うとB列にデータが入っていてG列が空白のデータも削除されてしまいますが、それでよろしいですか。
(デイト) 2014/08/21(木) 17:24

 >答えじゃありませんが、インデックス有効範囲に有りませんとエラー表示 
 >を実際にだしてみましたが、おそらくD E F の1行目も空白ですか、 
 >D E F G の1行目に文字や数字がないとこのエラーがでました。 

 これは既に考慮済み

 > B8に15004 F8が空白
 > B9に15005 F8も空白の場合
 >15004・15005と処理されるのですが、F列が空白の場合は結合せずにすると言う事は 出来ますでしょうか?

 獣毓さんから回答があるまでその辺は不明。

(seiya) 2014/08/21(木) 18:04


 D E F の1行目も空白です。
 デイト様のおっしゃる通りB列にデータが入っていてG列が空白の場合も削除されてしまいます。
 G列が空白の場合は、削除出来ない様に出来ますでしょうか?
 宜しくお願い致します。
 (獣毓)


 よくわかりません。
 G列に空白を入れた表を作成して、そこから期待する結果を表示してください。
(seiya) 2014/08/21(木) 19:32


 seiya様すみません。

  1   A		B		C		D		E	       F               G	
  2	      14232								             りんご農園
  3	      14233								             みかん市場
  4	      14238								             
  5	      15000								             りんご農園
  6	      15002								             みかん市場
  7	      15003								             りんご農園
  .
  50
                   ↓             ↓              ↓

  1   A		B	    	C		D		E	       F               G	
  2	      14232・15000・15003						                     りんご農園
  3	      14233・15002     						                             みかん市場
  4	      14238								             
  .
  50
 こんな感じが希望です。
 宜しくお願い致します。


 B列 G列共に空白の場合は?
(seiya) 2014/08/21(木) 19:46


 seiya様
 B列 G列共に空白の場合は、なにもしなくても良いです。そのままの状態でよいです。
 基本的にB列に必ず数字が入っております。B列に数字が入ってなく、G列に文字が入っている場合もありません。
 お願いします。
 (獣毓)


 これで試してください

 Sub test()
    Dim a, i As Long, ii As Long, n As Long, temp
    With ActiveSheet
        With Range("a1", .Cells.SpecialCells(11)).Resize(, 7)
            a = .Value
            With CreateObject("Scripting.Dictionary")
                For i = 1 To UBound(a, 1)
                    temp = IIf(a(i, 7) = "", i & Chr(2), a(i, 7))
                    If Not .exists(a(i, 7)) Then
                        n = n + 1: .Item(temp) = n
                        For ii = 1 To UBound(a, 2)
                            a(n, ii) = a(i, ii)
                        Next
                    Else
                        a(.Item(temp), 2) = _
                        a(.Item(temp), 2) & "・" & a(i, 2)
                    End If
                Next
            End With
            .ClearContents
            .Resize(n).Value = a
        End With
    End With
End Sub

(seiya) 2014/08/22(金) 06:37


 seiya様
 返事遅くなり申し訳有りません。
 希望通りになりました。有難う御座います。
 大分と処理するのが短縮され助かりました。
 (獣毓)


 以前、教えて頂きましたコードで良かったのですが、 判別する項目が増え思った通りになりません。

  1   A		B		C		D		E	       F               G	
  2	      14232		A農場						             りんご農園
  3	      14233		B農場						             みかん市場
  4	      14238		C農場						             
  5	      15000		A農場						             りんご農園
  6	      15002		C農場						             みかん市場
  7	      15003		B農場						             
  .
  50

                  ↓             ↓              ↓

  1   A		B	    	C		D		E	       F               G	
  2	      14232・15000		A農場				                         りんご農園
  3	      14233     		B農場				                             みかん市場
  4	      14238			C農場					                 
  5           15002           C農場                            みかん市場
  6      15003                     B農場
  50

 判定は、以前教えて頂きましたコードですとG列が空白の場合、14238・15003が結合されます。判定をG列>C列で優先した場合
 結果を出すコードを教えて頂けませんでしょうか?
 お手数ですがもうしばらくお付き合い下さい。宜しくお願い致します。


 こういうことですか?

 Sub test()
    Dim a, i As Long, ii As Long, n As Long, temp
    With ActiveSheet
        With .Range("a1", .Cells.SpecialCells(11)).Resize(, 7)
            a = .Value
            With CreateObject("Scripting.Dictionary")
                For i = 1 To UBound(a, 1)
                    temp = a(i, 7) & Chr(2) & a(i, 3)
                    If Not .exists(temp) Then
                        n = n + 1: .Item(temp) = n
                        For ii = 1 To UBound(a, 2)
                            a(n, ii) = a(i, ii)
                        Next
                    Else
                        a(.Item(temp), 2) = _
                        a(.Item(temp), 2) & "・" & a(i, 2)
                    End If
                Next
            End With
            .ClearContents
            .Resize(n).Value = a
        End With
    End With
End Sub
(seiya) 2014/11/19(水) 19:58

 獣毓さんへ。
 発言は↓のコメント欄から記入ください。
 発言の修正等でない場合は編集から書き込まないようにしてください。
(カリーニン) 2014/11/19(水) 20:36

 seiya様有難う御座いました。出来ました。

 カリーニン様、申し訳有りませんでした。以後気を付けます。

(獣毓) 2014/11/20(木) 10:07


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.