| |
▼ima さん：
こんにちは。
>こんにちは。ありがとうございます！ほぼ、ほぼ完成です。より理想に近づけるため、後は自力で修正しようとしたのですが…最後の1ステップ？で止まってしまいました。もう少しだけ診ていただけるでしょうか？
>'====================================================================
>Option Explicit
>'====================================================================
>Sub 統合2()
> Dim newshtnm()
> Dim oldshtnm()
> Dim idx As Long
> Dim 元ブック As Workbook
> Dim 集計ブック As Workbook
> Dim total_sht As Worksheet
> idx = 0
> Set 元ブック = ActiveWorkbook
> With 元ブック
> ReDim oldshtnm(1 To .Worksheets.Count, 1 To 1)
> For idx = 1 To Worksheets.Count
> oldshtnm(idx, 1) = .Worksheets(idx).Name
> Next
> End With
> newshtnm() = Range("a1", Cells(Rows.Count, 1).End(xlUp).Offset(-2, 0)).Value
>
>>ここで、Offset(-2,0)をOffset（-1,0）にする。
'これでよいと思います。
>
>Set 集計ブック = mk_book(newshtnm())
> With 集計ブック
> For idx = 1 To .Worksheets.Count
> With .Worksheets(idx)
> .Range("a1:c1").Value = Array("シート番号", "回答", "文字数")
> .Range("d2:d" & UBound(oldshtnm(), 1) + 1).Value = oldshtnm()
> .Range("a2:a" & UBound(oldshtnm(), 1) + 1).Formula = _
> "=row()-1"
> .Range("b2:b" & UBound(oldshtnm(), 1) + 1).Formula = _
> "=if(indirect(ADDRESS(" & idx & ",2,,,""[" & 元ブック.Name & "]""&d2))="""",""""," & _
> "indirect(ADDRESS(" & idx & ",2,,,""[" & 元ブック.Name & "]""&d2)))"
> .Range("c2:c" & UBound(oldshtnm(), 1) + 1).Formula = _
> "=len(b2)"
> .Cells(UBound(oldshtnm(), 1) + 2, 3).Formula = _
> "=sum(c2:c" & UBound(oldshtnm(), 1) + 1 & ")"
> With .Range("a2:b" & UBound(oldshtnm(), 1) + 1)
> .Value = .Value
> End With
> .Range("d2:d" & UBound(oldshtnm(), 1) + 1).Value = ""
> End With
> Next
> Set total_sht = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
>' ↓ここから、トータルシートの作成
> With total_sht
> .Name = "トータルシート"
> .Range("a1:b1").Value = Array("シート名", "文字数小計")
> .Range("a2:a" & UBound(newshtnm(), 1) + 1).Value = newshtnm()
>
>>ここで .Range("a2:a" & UBound(newshtnm(), 1)).Value = newshtnm() とする。
' ↑これ、ナイス修正です。
>
> .Range("b2:b" & UBound(newshtnm(), 1) + 1).Value = _
> "=indirect(address(" & UBound(oldshtnm(), 1) + 2 & ",3,,,a2))"
>
>>ここで .Range("b2:b" & UBound(newshtnm(), 1)).Value = _
>> "=indirect(address(" & UBound(oldshtnm(), 1) & ",3,,,a2))"
>>とする。
'問題は、↑ここ。集計ブックの各シートの文字数の合計値の位置は変わっていないので
' .Range("b2:b" & UBound(newshtnm(), 1)).Value = _
"=indirect(address(" & UBound(oldshtnm(), 1)+2 & ",3,,,a2))"
' ↑の「+2」は消さない
> .Cells(UBound(newshtnm(), 1) + 2, 2).Formula = _
> "=sum(b2:b" & UBound(newshtnm(), 1) + 1 & ")"
>
>>ここで .Cells(UBound(newshtnm(), 1) + 1, 2).Formula = _
>> "=sum(b2:b" & UBound(newshtnm(), 1) & ")" とする。
'これでよいと思います。
>
> End With
> End With
>End Sub
>'====================================================================
>Function mk_book(shtnm()) As Workbook
> Dim idx As Long
> Set mk_book = Workbooks.Add
> With mk_book
> For idx = LBound(shtnm()) To UBound(shtnm())
> If idx > .Worksheets.Count Then
> .Worksheets.Add after:=.Worksheets(.Worksheets.Count)
> End If
> .Worksheets(idx).Name = shtnm(idx, 1)
> Next idx
> End With
>End Function
>
>この直し方が正しいのかどうか自信ないのですが、とりあえず、シートの形だけは希望通りになりました。問題は、「トータルシート」のB列の「文字数小計」の数値が正しくないということです。B列に入っている数式（B2の場合）
>=INDIRECT(ADDRESS(30,3,,,A2))
>がおかしいのではと思うのですが、ここから先がお手上げです。
>どうぞよろしくお願いします。
>PS 連日時間を割いてくださってありがとうございます。また、本当に親切にお答えくださって感謝しています。おっしゃるとおり、コードを比較するだけも大変勉強になります。
私が確認した限りでは、上記の一箇所の訂正でよいと思いますが・・・。
|
|
ichinose
- 04/4/17(土) 11:50 -
