ここから本文です

VBAについて詳しい方力を貸してください。

アバター

ID非公開さん

2019/11/1400:15:09

VBAについて詳しい方力を貸してください。

下記のような表から、VBAにて①〜⑤をパターン別に分類分けを行いたく思いますが、どのような処理にて行うべきか、ご教示ください。

Criteria1,g&quot,A&quot,VBA,Set Dic,Dim c As String,End With

閲覧数:
64
回答数:
2
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

30246kikuさん

2019/11/1407:09:47

雰囲気、以下でどうなりますか

処理対象は、アクティブシートの A1 ~ の表



Option Explicit

Public Sub Samp1()
   Dim dic As Object
   Dim vA As Variant, v As Variant
   Dim i As Long, j As Long

   Set dic = CreateObject("Scripting.Dictionary")

   With Range("A1").CurrentRegion
      With Intersect(.Cells, .Offset(1))
         vA = .Value
         For i = 1 To UBound(vA)
            For j = 4 To UBound(vA, 2)
               vA(i, 3) = vA(i, 3) & vbTab & vA(i, j)
            Next
            v = dic(vA(i, 3))
            If (v = "") Then
               v = Split(Cells(1, dic.Count).Address, "$")(1)
               dic(vA(i, 3)) = v
            End If
            vA(i, 1) = v
         Next
         .Columns(1).Value = vA
      End With
   End With

   Set dic = Nothing
End Sub

この回答は投票によってベストアンサーに選ばれました!

ベストアンサー以外の回答

1〜1件/1件中

プロフィール画像

カテゴリマスター

hot********さん

2019/11/1400:53:15

例が少ないのでルールがよくわかりませんが、これでどうでしょうか。

Sub sample()
Dim lastRow As Long
Dim r As Long
Dim c As String
ActiveSheet.AutoFilterMode = False 'オートフィルタ解除(一応)
lastRow = Range("B" & Rows.Count).End(xlUp).Row 'B列最終行
Range("A2:A" & lastRow).ClearContents '分類クリア
c = "A" '分類(初期値="A")
For r = 2 To lastRow '注目行を2行目からB列最終行まで
If Range("A" & r).Value = "" Then 'もしA列注目行(分類)の値が空白なら
'注目行のC:G列の値でオートフィル
Range("C:G").AutoFilter Field:=1, Criteria1:=Range("C" & r).Value
Range("C:G").AutoFilter Field:=2, Criteria1:=Range("D" & r).Value
Range("C:G").AutoFilter Field:=3, Criteria1:=Range("E" & r).Value
Range("C:G").AutoFilter Field:=4, Criteria1:=Range("F" & r).Value
Range("C:G").AutoFilter Field:=5, Criteria1:=Range("G" & r).Value
Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).Value = c 'A列で表示しているセルの値を現在の分類の値にする
c = Chr(Asc(c) + 1) '分類の文字コード+1の文字(次の分類文字)
End If
Next
ActiveSheet.AutoFilterMode = False 'オートフィルタ解除
End Sub

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる