| |
▼ima さん：
こんばんは。
>下記「ファイル１」のように、回答用シート（B列はブランク）を作成しました。ファイル１には同じシートが10人分＝10シートあります。
>
>次にB列に回答してもらった後、マクロを使って「ファイル２」のように各質問ごとのシートに変えました。つまり、１人目から10人目までの回答の入った質問のシートが質問数分あります。（質問数はそのときによって変わります）
>
>今回行いたいのは、1.このファイル２の各シートのC列にB列の文字数を入れ、2.各シートあるいはいずれかのシートに文字数の合計を入れる ということです。（2.はできれば）
>LEN関数を使うことを考えましたが、シート数が多いので、また、ファイル１からファイル２を作る際のマクロにつなげて一連の作業でしたいのです。過去ログを見ましたが、類似のものが見当たらず、行き詰っています。どうかご教授ください。
非常に難しい入力データと出力データにしてしまいましたね！！
以下のコードを試してみて下さい。
元のブック（ima さんが言うファイル1）をアクティブにして実行してみて下さい。
'====================================================================
Option Explicit
Sub 統合2()
Dim newshtnm()
Dim oldshtnm()
Dim idx As Long
Dim 元ブック As Workbook
Dim 集計ブック As Workbook
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)).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 = _
"=indirect(ADDRESS(" & idx & ",2,,,""[" & 元ブック.Name & "]""&d2))"
.Range("c2:c" & UBound(oldshtnm(), 1) + 1).Formula = _
"=len(b2)"
With .Range("a2:c" & UBound(oldshtnm(), 1) + 1)
.Value = .Value
End With
.Range("d2:d" & UBound(oldshtnm(), 1) + 1).Value = ""
End With
Next
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
簡単なテストしかしていませんが・・・。
確認してみて下さい。
尚、Excel2000で確認しています。
|
|
ichinose
- 04/4/13(火) 19:11 -
