| |
▼ima さん：
こんばんは。
一応、imaさんのご希望に沿うようなコードにしたつもりです。
前回のコードと比較して下さい。変更点は、ちょっとしたところですから・・。
'====================================================================
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
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("b2:b" & UBound(newshtnm(), 1) + 1).Value = _
"=indirect(address(" & UBound(oldshtnm(), 1) + 2 & ",3,,,a2))"
.Cells(UBound(newshtnm(), 1) + 2, 2).Formula = _
"=sum(b2:b" & UBound(newshtnm(), 1) + 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
マクロ実行は前回と同様に元ブックをアクティブにして実行して下さい。
>集計ブック-Sheet1（Q1のシート）
> A列 B列 C列
>1 シート番号 回答 文字数
>2 1 ○○○ 3
>・ 2 ●●●● 4
>・ ・ ・ ・
>・ ・ ・ ・
>・ X \\\ 3
>
>集計ブック-最後のSheet（回答者）
> A列 B列 C列
>1 シート番号 回答 文字数
>2 1 AAAA 4
>・ 2 BBBB 4
>・ ・ ・ ・
>・ ・ ・ ・
>・ X YYYY 4
>
>もうひとつは、最終目的である、各回答の文字数の総計を新しいシートに出したいのです。イメージとしては、集計ブックの新しいシートに下記のようなものができればよいのですが・・（レイアウトは問いません）
>
> A列 B列
>１ シート名 文字数小計
>２ Q1 （上記集計ブック-Sheet1のC列の合計値）
>３ Q2 （Sheet2のC列の合計値）
>・ ・ ・
>・ ・ ・
>ｚ QX （最後の質問のSheetのC列の合計値）
>ｚ+1 （B2：Bzの総計）
ほぼ、↑のように集計されるはずです。
数式をそのまま残しておきましたので、
例えば、集計ブックのQ1のＢ列（回答）を修正した場合､
Ｃ列の文字数に反映しますし、トータルシートの合計値も変更されるように
してあります。
>説明不足ですみません。
いいえ、これだけの仕様を提示して頂きました。
わかりやすかったですよ！！（まっ、これで仕様と違ったら、私の読解力不足です）
私が書いたコードは、せいぜい60ステップ程度ですが、
そのための仕様書となったら、最初の投稿と合わせてこれだけ書かなければならないということですよね？
この手の質問は、「仕様書を書く」勉強になるかも？
何はともあれ、確認して下さい。
|
|
ichinose
- 04/4/15(木) 21:32 -
