[[20211014143431]]　『複数ブックから複数条件に合致する文字列を抽出し』（こば）　ページの最後に飛ぶ

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

　

『複数ブックから複数条件に合致する文字列を抽出し転記したい』（こば） 

 こんにちは。質問ですが、[[20210630143416]]を参考にして種類ごとに分かれた商品リストのブックを参照して、条件に合う文字列を別ブックに転記するマクロを作成しています。


  _|___A____|___B____|___C____|___D____|__　　
  1|        |        |        |        |   
  2|        |        |        |　　　　|
  3|　品種  |地区    |収穫量  |種類　　|
  4|紅玉    |A地区   |B       |リンゴ　|
  5|紅玉    |B地区   |C       |リンゴ　|  　・・・テストデータフォルダ内のリンゴ、ぶどうなど7種類のリスト
  6|紅玉    |C地区   |A       |リンゴ　|     
  7|北斗    |A地区   |D       |リンゴ　|
  8|北斗    |B地区   |C       |リンゴ　|
  9|ふじ    |A地区   |A       |リンゴ　|
 10|トキ　　|A地区   |B       |リンゴ　|
　　　　　　　・
　　　　　　　・
　　　　　　　・


 上記の表から地区名と収穫量と種類に合致する品種を別ブックの下記のようなシートに抽出します。


 __|___A____|___B______ |___C_______|___D____|__
  1|        |           |           |        |
  2|        |           |           |        |
  3|A地区   |リンゴ     |ブドウ     |ナシ    | 
  4|A       |    　     |           |幸水    |
  5|B       |紅玉       |ピオーネ   |あきづき| 
  6|C       |ふじ　     |           |　　　　|
  7|D       |北斗　　   |       　　|        |
  8|B,D     |紅玉|北斗  |ピオーネ   |あきづき|
  9|A,D     |北斗       |　         |        |
   |        |           |           |        | 
   |        |           |           |        |


 ↓のマクロを実行した場合、「オブジェクトが必要です」とエラーが出ましたが、どこを修正すればよろしいでしょうか。


 Sub test()
       Dim i As Long
       Dim sFileName As String
       Dim wb As Workbook
       Dim ws As Worksheet
       Dim s一覧 As Worksheet
       Dim sリスト As Worksheet
       Set s一覧 = Worksheets("一覧")
       Set sリスト = Worksheets("リスト")


       With s一覧
            .Range("A:A").ClearContents
            sFileName = Dir(ThisWorkbook.Path & "\テストデータ\*.xlsx")
            i = 1
            Do Until sFileName = ""
                .Cells(i, 1) = ThisWorkbook.Path & "\テストデータ\" & sFileName
                i = i + 1
                sFileName = Dir()
            Loop
        End With


        Dim MyRNG As Range


        With sリスト
            For i = 1 To s一覧.Cells(s一覧.Rows.Count, 1).End(xlUp).Row
            Set wb = Workbooks.Open(s一覧.Cells(i, 1))
            Set ws = wb.Worksheets(1)


            For Each MyRNG In .Range("A4:D9")
                Set MyRNG.Value = リスト抽出(ws.Range("A2").CurrentRegion.Resize(.Rows.Count - 1).Offset(1).Select, .Cells(2, 2).Value, .Cells(MyRNG.Row, "A").Value, .Cells(3, MyRNG.Column).Value)
            Next MyRNG
            Next
        End With
        ws.Parent.Close SaveChanges:=False
    End Sub

 Function リスト抽出(表範囲 As Range, 地区 As String, ランク As String, 種類 As String) As String
        Dim buf As String, 行 As Long
        For 行 = 1 To 表範囲.Rows.Count
            If 表範囲.Cells(行, 2).Value = 地区 Then 
                If 表範囲.Cells(行, 4).Value = 種類 Then 
                    If UBound(Filter(Split(ランク, ","), 表範囲.Cells(行, 3).Value)) > -1 Then 
                        buf = buf & 表範囲.Cells(行, 1).Value & "|"
                    End If
                End If
            End If
        Next 行
        If buf <> "" Then buf = Left(buf, Len(buf) - 1)
        リスト抽出 = buf
    End Function

＜ 使用 Excel：unknown、使用 OS：unknown ＞ 

 Set MyRNG.Value = リスト抽出(ws.Range("A2").CurrentRegion.Resize(.Rows.Count - 1).Offset(1).Select, .Cells(2, 2).Value, .Cells(MyRNG.Row, "A").Value, .Cells(3, MyRNG.Column).Value)
↑
とりあえず。。。＾＾；
みたいな感じがするのですが。なにをなさっているのか、
教えて頂けますでせうか。m(_ _)m
（隠居Ｚ） 2021/10/14(木) 15:36
追伸
エクセル
ＯＳ
の名前＆バージョンを明示頂くとアドバイス獲得率が上がるかもしれません
m(__)m
（隠居Ｚ） 2021/10/14(木) 15:40 
 ちょい見なので外しているかもですが
setとselect
は要らないのでは
これ以上はテスト出来る環境作成不可なので
申し上げられません。これにて、私は失礼致します。
外していましたらお許しを、引き続き他の回答者様
の回答をお待ち下さいませ。m(_ _)m
（隠居Ｚ） 2021/10/14(木) 15:54
[[20210630143416]] 『リスト形式の表から複数条件に合致する名前を抽出』（みちる） 

 ↑参考にした質問です。


 隠居Ｚさんご返信ありがとうございます。


 >Set MyRNG.Value = リスト抽出(ws.Range("A2").CurrentRegion.Resize(.Rows.Count - 1).Offset(1).Select, .Cells(2, 2).Value, .Cells(MyRNG.Row, "A").Value, .Cells(3, MyRNG.Column).Value)


 ↑すいません。リスト抽出のFunction関数の範囲はA4からデータが入っているので、ws.Range("A4")でした。
　例の表も間違えていました。まぎらわしいのでリンゴの例だけ載せます。


  _|___A____|___B____|___C____|___D____|__　　
  1|        |        |        |        |   
  2|        |        |        |　　　　|
  3|　品種  |地区    |収穫量  |種類　　|
  4|紅玉    |A地区   |B       |リンゴ　|
  5|紅玉    |B地区   |C       |リンゴ　|  　・・・テストデータフォルダ内のリンゴ、ぶどうなど7種類のリスト
  6|紅玉    |C地区   |A       |リンゴ　|     
  7|北斗    |A地区   |D       |リンゴ　|
  8|北斗    |B地区   |C       |リンゴ　|
  9|ふじ    |A地区   |A       |リンゴ　|
 10|トキ　　|A地区   |B       |リンゴ　|
　　　　　　　・
　　　　　　　・
　　　　　　　・
 上記の表から地区名と収穫量と種類に合致する品種を別ブックの下記のようなシートに抽出します。
 __|___A____|___B______ |___C_______|___D____|__
  1|        |           |           |        |
  2|        |           |           |        |
  3|A地区   |リンゴ     |ブドウ     |ナシ    | 
  4|A       |ふじ    　 |           |        |
  5|B       |紅玉|トキ  |           |        | 
  6|C       |　　　     |           |　　　　|
  7|D       |北斗　　   |　　　     |        |      
  8|B,D     |紅玉|トキ  |           |        |
   |        ||北斗      |           |        |
  9|A,D     |ふじ| 北斗 |　         |        |
   |        |           |           |        | 
   |        |           |           |        | 


 失礼いたしました。OSとバージョンは下記のとおりです。


 ★OS：Windows10  Excelバージョン：2019

（こば） 2021/10/14(木) 16:13

お世話になります。昨日の質問ですが、アドバイスを受けて試行錯誤しましたがまだ解決出来ません。
ステップインで確認したらFor Each～Nextが無限ループを起こしていました。
なのでFor Each～NextをFor i～の前に置きましたら今度はFor Each～Nextがセル範囲に対してループしてくれません。
どのように修正すればよろしいでしょうか？ 

 Sub test()
       Dim i As Long
       Dim sFileName As String
       Dim wb As Workbook
       Dim ws As Worksheet
       Dim s一覧 As Worksheet
       Dim sリスト As Worksheet
       Set s一覧 = Worksheets("一覧")
       Set sリスト = Worksheets("リスト")
       With s一覧
            .Range("A:A").ClearContents
            sFileName = Dir(ThisWorkbook.Path & "\テストデータ\*.xlsx")
            i = 1
            Do Until sFileName = ""
                .Cells(i, 1) = ThisWorkbook.Path & "\テストデータ\" & sFileName
                i = i + 1
                sFileName = Dir()
            Loop
        End With
        Dim MyRNG As Range
        With sリスト
            For i = 1 To s一覧.Cells(s一覧.Rows.Count, 1).End(xlUp).Row
            Set wb = Workbooks.Open(s一覧.Cells(i, 1))
            Set ws = wb.Worksheets(1)
            Set テーブル1 = ws.Range("テーブル1")


            For Each MyRNG In .Range("A4:D9")　'★ここで無限ループが起こる
                Set MyRNG.Value = リスト抽出(ws.Range("テーブル1"), .Cells(3, 1).Value, .Cells(MyRNG.Row, "A").Value, .Cells(3, MyRNG.Column).Value)
            Next MyRNG
            Next
        End With
        ws.Parent.Close SaveChanges:=False
    End Sub

 Function リスト抽出(表範囲 As Range, 地区 As String, ランク As String, 種類 As String) As String
        Dim buf As String, 行 As Long
        For 行 = 1 To 表範囲.Rows.Count
            If 表範囲.Cells(行, 2).Value = 地区 Then 
                If 表範囲.Cells(行, 4).Value = 種類 Then 
                    If UBound(Filter(Split(ランク, ","), 表範囲.Cells(行, 3).Value)) > -1 Then 
                        buf = buf & 表範囲.Cells(行, 1).Value & "|"
                    End If
                End If
            End If
        Next 行
        If buf <> "" Then buf = Left(buf, Len(buf) - 1)
        リスト抽出 = buf
    End Function
（こば） 2021/10/15(金) 15:17

 基本 For Each はループの要素数がきまっているので、無限ループにはならないはずです。


 Set MyRNG.Value = リスト抽出( ・・・・
 って、ここで、オブジェクトが必要です　という実行時エラーになりませんか？
 そのままデバッグボタン押して続行すれば、そりゃ無限にエラー発生のループに陥りますが．．．


 隠居Ｚさんが、Setいらないって書いてますよね？


 MyRNG.Value = リスト抽出(　 ・・・・
　
（´・ω・`） 2021/10/15(金) 16:09

 (´・ω・`）さんご返信ありがとうございます。


 >基本 For Each はループの要素数がきまっているので、無限ループにはならないはずです。

すいません。無限ループは間違いでした。ブックを変更しながら、For Each～Nextでセル範囲をループさせながらFunction関数を実行したいが、For i～に戻らないという意味でした。 

 >MyRNG.Value = リスト抽出(　 ・・・・

　すいません。質問にSETを書いしまいましたが、画面では消してあり、エラーは起きませんでした。
（こば） 2021/10/15(金) 16:37 

 申し訳ありませんが、質問内容と現在の問題点について再整理お願いします。


 >すいません。質問にSETを書いしまいましたが、画面では消してあり、エラーは起きませんでした。
 こういうやり取りは時間の無駄です。
（´・ω・`） 2021/10/15(金) 16:46

 ステップイン(ステップインボタン又はF8キー)でデバックしているようなので、
 以下を確認してから、質問内容に整理をされたらどうでしょうか。


 For Each MyRNG In .Range("A4:D9")  '★ここで無限ループが起こる
     Debug.Print a.Address(0, 0, , 1)
     'MyRNG.Value = ~~コメントアウトする
 Next MyRNG


 イミディエイトウィンドウにMyRNGが何なのか[ブック名]シート名!セルで表示されます。
 ご自身が想定しているものであるか、まず確認してみては。

（tkit） 2021/10/15(金) 16:59 

 ＞無限ループは間違いでした。ブックを変更しながら、
 ＞For Each～Nextでセル範囲をループさせながらFunction関数を実行したいが、
 ＞For i～に戻らないという意味でした。


 ということは、
 For i = 1 To s一覧.Cells(s一覧.Rows.Count, 1).End(xlUp).Row　の
 s一覧.Cells(s一覧.Rows.Count, 1).End(xlUp).Row　が1なのでは？
 (つまり見出し行しかない)　

（めいぷる） 2021/10/15(金) 17:05

申し訳ありません。何人かの方に回答を頂きましたが、質問の再整理させて頂きます。

（質問）
複数ブックから条件に合致する品種をリストに転記するマクロを作成したいです。 

  _|___A____|___B____|___C____|___D____|__　　
  1|        |        |        |        |   
  2|        |        |        |　　　　|
  3|　品種  |地区    |ランク  |種類　　|
  4|紅玉    |A地区   |B       |リンゴ　|
  5|紅玉    |B地区   |C       |リンゴ　|  　・・・データフォルダ内のリンゴ、ぶどうなど7種類のブック
  6|紅玉    |C地区   |A       |リンゴ　|     
  7|北斗    |A地区   |D       |リンゴ　|
  8|北斗    |B地区   |C       |リンゴ　|
  9|ふじ    |A地区   |A       |リンゴ　|
 10|トキ　　|A地区   |B       |リンゴ　|
　　　　　　　・
　　　　　　　・
　　　　　　　・


 上記の表から地区名とランクと種類に合致する品種を下記のような様式のリストに転記します。


 __|___A____|___B______ |___C_______|___D____|__
  1|        |           |           |        |
  2|        |           |           |        |
  3|A地区   |リンゴ     |ブドウ     |ナシ    | 
  4|A       |ふじ    　 |           |        |
  5|B       |紅玉|トキ  |           |        | 
  6|C       |　　　     |           |　　　　|   
  7|D       |北斗　　   |　　　     |        |      
  8|B,D     |紅玉|トキ  |           |        |
   |        ||北斗      |           |        |
  9|A,D     |ふじ| 北斗 |　         |        |
   |        |           |           |        | 
   |        |           |           |        |

（現在の問題点）
一回目のFor EachのFunction関数の終了後、For i～に戻り、次のブックを開く前に次のFunction関数の処理が始まってしまいます。 

 Sub test()
       Dim i As Long
       Dim sFileName As String
       Dim wb As Workbook
       Dim ws As Worksheet
       Dim s一覧 As Worksheet
       Dim s生物情報 As Worksheet
       Set s一覧 = Worksheets("一覧")
       Set s生物情報 = Worksheets("リスト")


       With s一覧
            .Range("A:A").ClearContents
            sFileName = Dir(ThisWorkbook.Path & "\データ\*.xlsx")
            i = 1
            Do Until sFileName = ""
                .Cells(i, 1) = ThisWorkbook.Path & "\データ\" & sFileName
                i = i + 1
                sFileName = Dir()
            Loop


        End With


        Dim MyRNG As Range
        Dim テーブル1 As Range


        With s生物情報


            For i = 1 To s一覧.Cells(s一覧.Rows.Count, 1).End(xlUp).Row
            Set wb = Workbooks.Open(s一覧.Cells(i, 1))
            Set ws = wb.Worksheets(1)
            Set テーブル1 = ws.Range("テーブル1")


             For Each MyRNG In .Range("B4:D9")


             MyRNG.Value = リスト抽出(ws.Range("テーブル1"), .Cells(3, 1).Value, .Cells(MyRNG.Row, "A").Value, .Cells(3, MyRNG.Column).Value)
            Next MyRNG　'★Function関数終了後にここからFor i～に戻りたいが、Function関数の処理が始まってしまう。
            Next


        End With
        ws.Parent.Close SaveChanges:=False
    End Sub

 Function リスト抽出(表範囲 As Range, 地区 As String, ランク As String, 種類 As String) As String
        Dim buf As String, 行 As Long


        For 行 = 1 To 表範囲.Rows.Count


            If 表範囲.Cells(行, 2).Value = 地区 Then 
                If 表範囲.Cells(行, 4).Value = 種類 Then 
                    If UBound(Filter(Split(ランク, ","), 表範囲.Cells(行, 3).Value)) > -1 Then 
                        buf = buf & 表範囲.Cells(行, 1).Value & "|"
                    End If
                End If
            End If
            Next 行
        If buf <> "" Then buf = Left(buf, Len(buf) - 1)
        リスト抽出 = buf
    End Function

（こば） 2021/10/15(金) 17:21 

 よく分からないので、Functionは無視。


 Sub test()
     Dim i As Long
     Dim sFileName As String
     Dim wb As Workbook
     Dim ws As Worksheet
     Dim s一覧 As Worksheet
     Dim s生物情報 As Worksheet
     Dim テーブル1 As Range
     Dim Result, rX As Range, rY As Range, n, rlstY, rsltX, buf, v


     Set s一覧 = Worksheets("一覧")
     Set s生物情報 = Worksheets("リスト")


     With s一覧
         .Range("A:A").ClearContents
         sFileName = Dir(ThisWorkbook.Path & "\データ\*.xlsx")


         i = 1
         Do Until sFileName = ""
             .Cells(i, 1) = ThisWorkbook.Path & "\データ\" & sFileName
             i = i + 1
             sFileName = Dir()
         Loop
     End With


     With s生物情報.Range("B4:D9") '結果表示範囲
         .ClearContents
         Result = .Value
         Set rX = .Offset(-1).Rows(1).Cells
         Set rY = .Offset(, -1).Columns(1).Cells
     End With


     For i = 1 To s一覧.Cells(s一覧.Rows.Count, 1).End(xlUp).Row
         Set wb = Workbooks.Open(s一覧.Cells(i, 1))
         Set ws = wb.Worksheets(1)
         Set テーブル1 = ws.Range("テーブル1")


         For n = 1 To テーブル1.Rows.Count
             If テーブル1.Cells(n, 2) = s生物情報.Range("A3") Then '地区が合致
                 rsltX = Application.Match(テーブル1.Cells(n, 4), rX, 0)


                 If IsNumeric(rsltX) Then


                     For rlstY = 1 To UBound(Result)
                         v = テーブル1.Cells(n, "C")


                         If InStr("," & rY(rlstY, 1) & ",", "," & v & ",") Then
                             buf = Result(rlstY, rsltX)
                             Result(rlstY, rsltX) = buf & IIf(buf <> "", "|", "") & テーブル1.Cells(n, 1)
                         End If
                     Next rlstY
                 End If
             End If
         Next n


         wb.Close SaveChanges:=False
     Next i


     s生物情報.Range("B4").Resize(UBound(Result), UBound(Result, 2)).Value = Result


 End Sub

（半平太） 2021/10/15(金) 21:02　 (微調整23:55)

ご返信遅くなり申し訳ありません。
半平太さん、ありがとうございます。無事質問は解決しました！
さらに追加で皆様にアドバイス頂きたいのですが、転記した文字列の種類ごとに、ランクAとCのみの合計をB10～D10に追加したいのですが、自分で作成したマクロではtotal = total + arr(j)の部分で「型が一致しません」とエラーが出てしまいました。文字列の合計を求めるにはどう記述したらよいでしょうか？ 

 __|___A____|___B______ |___C_______|___D____|__
  1|        |           |           |        |
  2|        |           |           |        |
  3|A地区   |リンゴ     |ブドウ     |ナシ    | 
  4|A       |ふじ    　 |           |        |
  5|B       |紅玉|トキ  |           |        | 
  6|C       |　　　     |           |　　　　|   
  7|D       |北斗　　   |　　　     |        |      
  8|B,D     |紅玉|トキ  |           |        |
   |        ||北斗      |           |        |
  9|A,D     |ふじ| 北斗 |　         |        |
 10|合計    |    1      |           |        | 
   |        |           |           |        | 


 Sub test()
     Dim i As Long
     Dim sFileName As String
     Dim wb As Workbook
     Dim ws As Worksheet
     Dim s一覧 As Worksheet
     Dim s生物情報 As Worksheet
     Dim テーブル1 As Range
     Dim Result, rX As Range, rY As Range, n, rlstY, rsltX, buf, v
     Set s一覧 = Worksheets("一覧")
     Set s生物情報 = Worksheets("リスト")
     With s一覧
         .Range("A:A").ClearContents
         sFileName = Dir(ThisWorkbook.Path & "\データ\*.xlsx")
         i = 1
         Do Until sFileName = ""
             .Cells(i, 1) = ThisWorkbook.Path & "\データ\" & sFileName
             i = i + 1
             sFileName = Dir()
         Loop
     End With
     With s生物情報.Range("B4:D9") '結果表示範囲
         .ClearContents
         Result = .Value
         Set rX = .Offset(-1).Rows(1).Cells
         Set rY = .Offset(, -1).Columns(1).Cells
     End With
     For i = 1 To s一覧.Cells(s一覧.Rows.Count, 1).End(xlUp).Row
         Set wb = Workbooks.Open(s一覧.Cells(i, 1))
         Set ws = wb.Worksheets(1)
         Set テーブル1 = ws.Range("テーブル1")
         For n = 1 To テーブル1.Rows.Count
             If テーブル1.Cells(n, 2) = s生物情報.Range("A3") Then '地区が合致
                 rsltX = Application.Match(テーブル1.Cells(n, 4), rX, 0)
                 If IsNumeric(rsltX) Then
                     For rlstY = 1 To UBound(Result)
                         v = テーブル1.Cells(n, "C")
                         If InStr("," & rY(rlstY, 1) & ",", "," & v & ",") Then
                             buf = Result(rlstY, rsltX)
                             Result(rlstY, rsltX) = buf & IIf(buf <> "", "|", "") & テーブル1.Cells(n, 1)
                         End If
                     Next rlstY
                 End If
             End If
         Next n
         wb.Close SaveChanges:=False
     Next i
     s生物情報.Range("B4").Resize(UBound(Result), UBound(Result, 2)).Value = Result


    Dim arr(1 To 2) As String　←★追加した合計を求めるマクロ


     arr(1) = Result(1, 2)
     arr(2) = Result(3, 2)


    Dim total As Long, j As Long


     For j = LBound(arr) To UBound(arr)


    total = total + arr(j)
  Next j


  s生物情報.Range("B10").Value = total


 End Sub
（こば） 2021/10/19(火) 15:02

 よく分かりませんが、1に合わせるなら


     Dim arr(1 To 2) As String  '←★追加した合計を求めるマクロ


     arr(1) = Result(1, 1)
     arr(2) = Result(3, 1)


     Dim total As Long, j As Long
     For j = LBound(arr) To UBound(arr)
 　　    total = total + IIf(arr(j) = "", 0, UBound(Split(arr(j) & "|", "|")))
   　Next j


   　s生物情報.Range("B10").Value = total

（半平太） 2021/10/19(火) 15:59

半平太さん、ご返信ありがとうございます。

理想通りの結果になったのですが、種類の列が7列（～H列）まである場合、どのように書き換えればよろしいでしょうか。お手数をおかけして申し訳ありませんが、ご教授頂ければ幸いです。
（こば） 2021/10/19(火) 16:31

 とりあえず、これで試してください。


 Sub test()
    Dim i As Long, c As Long
    Dim sFileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim s一覧 As Worksheet
    Dim s生物情報 As Worksheet
    Dim テーブル1 As Range
    Dim Result, rX As Range, rY As Range, n, rlstY, rsltX, buf, v


    Set s一覧 = Worksheets("一覧")
    Set s生物情報 = Worksheets("リスト")


    With s一覧
        .Range("A:A").ClearContents
        sFileName = Dir(ThisWorkbook.Path & "\データ\*.xlsx")


        i = 1
        Do Until sFileName = ""
            .Cells(i, 1) = ThisWorkbook.Path & "\データ\" & sFileName
            i = i + 1
            sFileName = Dir()
        Loop
    End With


    With s生物情報.Range("B4:H10") '結果表示範囲
        .ClearContents
        Result = .Value
        Set rX = .Offset(-1).Rows(1).Cells
        Set rY = .Offset(, -1).Columns(1).Cells
    End With


    For i = 1 To s一覧.Cells(s一覧.Rows.Count, 1).End(xlUp).Row
        Set wb = Workbooks.Open(s一覧.Cells(i, 1))
        Set ws = wb.Worksheets(1)
        Set テーブル1 = ws.Range("テーブル1")


        For n = 1 To テーブル1.Rows.Count
            If テーブル1.Cells(n, 2) = s生物情報.Range("A3") Then '地区が合致
                rsltX = Application.Match(テーブル1.Cells(n, 4), rX, 0)


                If IsNumeric(rsltX) Then


                    For rlstY = 1 To UBound(Result)
                        v = テーブル1.Cells(n, "C")


                        If InStr("," & rY(rlstY, 1) & ",", "," & v & ",") Then
                            buf = Result(rlstY, rsltX)
                            Result(rlstY, rsltX) = buf & IIf(buf <> "", "|", "") & テーブル1.Cells(n, 1)
                        End If
                    Next rlstY
                End If
            End If
        Next n


        wb.Close SaveChanges:=False
    Next i


    '合計を求める
    For c = 1 To 7
        For i = 1 To 3 Step 2 'AとC
            Result(7, c) = Result(7, c) + IIf(Result(i, c) = "", 0, UBound(Split(Result(i, c) & "|", "|")))
        Next i
    Next c


    s生物情報.Range("B4:H10") = Result
End Sub

（半平太） 2021/10/19(火) 16:59

半平太さん、ありがとうございます！とても助かりました！

他の皆様もお付き合い下り、どうもありがとうございました。ｍ（＿ ＿）ｍ
（こば） 2021/10/19(火) 17:36

コメント返信：

[ 一覧(最新更新順) ]

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