| |
▼ima さん：
こんにちは。ありがとうございます！ほぼ、ほぼ完成です。より理想に近づけるため、後は自力で修正しようとしたのですが…最後の1ステップ？で止まってしまいました。もう少しだけ診ていただけるでしょうか？
直したかったのは、下記の様に、1.元ブックの「注記」（A列最後から2番目の項目）も集計ブックに載せ（C列の「文字数」はなくてもよい）にし
元ブック-Sheet1（一人目）
A B
１ Q1 ○○○（文字列）
２ Q2 △△△△
３ Q3 ◇◇
・ ・
・ ・
・ QX（最後の質問）×××
・ 注記 ◎◎
・ 回答者 AAAA
集計ブック-「注記」のSheet（最後のシート）
A列 B列 C列
1 シート番号 回答 文字数
2 １ ◎◎ 2
・ ２ ●●●● 4
・ ・ ・ ・
・ ・ ・ ・
・ X \\\ 3
2.「トータルシート」にて、ichinoseさんが作ってくださった状態にすること（「注記」sheetの文字数はカウントに入らないようにする）
でした。
自分で直した箇所は、
'====================================================================
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))"
>とする。
.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 連日時間を割いてくださってありがとうございます。また、本当に親切にお答えくださって感謝しています。おっしゃるとおり、コードを比較するだけも大変勉強になります。
|
|
ima
- 04/4/16(金) 17:29 -
