Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


12002 / 13646 ツリー ←次へ | 前へ→

【12739】VBAで文字数カウントしたいのですが(長... ima 04/4/13(火) 17:04 質問
【12744】Re:VBAで文字数カウントしたいのですが(長... ichinose 04/4/13(火) 19:11 回答
【12755】Re:VBAで文字数カウントしたいのですが(... ima 04/4/14(水) 11:23 質問
【12784】Re:VBAで文字数カウントしたいのですが(... ichinose 04/4/14(水) 19:09 発言
【12802】Re:VBAで文字数カウントしたいのですが(... ima 04/4/15(木) 13:42 質問
【12814】Re:VBAで文字数カウントしたいのですが(... ichinose 04/4/15(木) 21:32 回答
【12839】Re:VBAで文字数カウントしたいのですが(... ima 04/4/16(金) 17:29 質問
【12861】Re:VBAで文字数カウントしたいのですが(... ichinose 04/4/17(土) 11:50 発言
【12910】Re:VBAで文字数カウントしたいのですが(... ima 04/4/19(月) 16:23 お礼
【12840】Re:VBAで文字数カウントしたいのですが(... ima 04/4/16(金) 17:33 発言

【12739】VBAで文字数カウントしたいのですが(長...
質問  ima  - 04/4/13(火) 17:04 -

引用なし
パスワード
   下記「ファイル1」のように、回答用シート(B列はブランク)を作成しました。ファイル1には同じシートが10人分=10シートあります。

次にB列に回答してもらった後、マクロを使って「ファイル2」のように各質問ごとのシートに変えました。つまり、1人目から10人目までの回答の入った質問のシートが質問数分あります。(質問数はそのときによって変わります)

今回行いたいのは、1.このファイル2の各シートのC列にB列の文字数を入れ、2.各シートあるいはいずれかのシートに文字数の合計を入れる ということです。(2.はできれば)
LEN関数を使うことを考えましたが、シート数が多いので、また、ファイル1からファイル2を作る際のマクロにつなげて一連の作業でしたいのです。過去ログを見ましたが、類似のものが見当たらず、行き詰っています。どうかご教授ください。

ファイル2を作る際のコードは一番下に載せています。

ファイル1-Sheet1(一人目)    ファイル1-Sheet2(二人目)…Sheet10まである    
    A    B                 A    B
1   Q1    ○○○(文字列)    1   Q1    ●●●●
2   Q2    △△△△        2   Q2    ■■
3   Q3    ◇◇          3   Q3    ▲▲▲
・   ・                ・    ・
・   ・                ・    ・
・   QX    ×××             QX    ???


ファイル2-Sheet1(Q1のシート)…QXのシートまである
     A        B
1    シート番号    回答
2     1        ○○○
・     2        ●●●●
・     ・        
・     ・
11     10        \\\

Option Explicit
Sub 統合2()
  集約2
  分割2
  
End Sub
Private Sub 集約2()
  Dim shSource As Worksheet, rngSource As Range
  Dim bookSource As Workbook: Set bookSource = ActiveWorkbook
  Dim rngDestination As Range
  Set rngDestination = Workbooks.Add(xlWBATWorksheet).Sheets(1).Range("B2")
  rngDestination.Offset(-1, -1).FormulaR1C1 = "シート番号"
  rngDestination.Offset(-1, 0).FormulaR1C1 = "質問番号"
  rngDestination.Offset(-1, 1).FormulaR1C1 = "回答"
 
  For Each shSource In bookSource.Worksheets
   If True Then
    Set rngSource = shSource.UsedRange
    rngSource.Copy rngDestination
    rngDestination.Resize(rngSource.Rows.Count).Offset(, -1).Formula = shSource.Name
    Set rngDestination = rngDestination.Offset(rngSource.Rows.Count)
   End If
  Next
End Sub
Private Sub 分割2()
  Dim shDestination As Worksheet
  Dim shSource As Worksheet: Set shSource = ActiveSheet
  Dim vnt質問番号s As Variant, vnt質問番号 As Variant
  vnt質問番号s = Array("Q1", "Q2", "Q3", "Q4", "Q5", "Q6", "Q7", "Q8", "Q9")
  For Each vnt質問番号 In vnt質問番号s
  Set shDestination = Sheets.Add
  shDestination.Name = vnt質問番号
  shSource.Range("A1").AutoFilter Field:=2, Criteria1:=vnt質問番号
  shSource.Range("A:A,C:D").Copy shDestination.Range("A1")
  Next
  Sheets(vnt質問番号s).Select
  
End Sub

【12744】Re:VBAで文字数カウントしたいのですが(...
回答  ichinose  - 04/4/13(火) 19:11 -

引用なし
パスワード
   ▼ima さん:
こんばんは。

>下記「ファイル1」のように、回答用シート(B列はブランク)を作成しました。ファイル1には同じシートが10人分=10シートあります。
>
>次にB列に回答してもらった後、マクロを使って「ファイル2」のように各質問ごとのシートに変えました。つまり、1人目から10人目までの回答の入った質問のシートが質問数分あります。(質問数はそのときによって変わります)
>
>今回行いたいのは、1.このファイル2の各シートのC列にB列の文字数を入れ、2.各シートあるいはいずれかのシートに文字数の合計を入れる ということです。(2.はできれば)
>LEN関数を使うことを考えましたが、シート数が多いので、また、ファイル1からファイル2を作る際のマクロにつなげて一連の作業でしたいのです。過去ログを見ましたが、類似のものが見当たらず、行き詰っています。どうかご教授ください。

非常に難しい入力データと出力データにしてしまいましたね!!
以下のコードを試してみて下さい。
元のブック(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で確認しています。

【12755】Re:VBAで文字数カウントしたいのですが(...
質問  ima  - 04/4/14(水) 11:23 -

引用なし
パスワード
   ▼ichinose さん:

早急なご回答ありがとうございます!試したところ、前のコードよりずっと処理が早く(感動です!)、ほぼ希望の通りとなりました。(前のコードは過去ログの寄せ集めだったもので…)

集計ブックを見て、やはり文字数カウントの合計値がほしいと思ったのですが、一連の動作で、集計ブックに新しいシートを追加して、各シートのC列(文字数カウント列)をコピー、総合計を出すというのは可能でしょうか?
下記の箇所を手作業で文字数カウントを修正する必要があり、このシート上でできればよいのですが。。
・解答欄が空白の場合、「O」が返り、文字数が「1」とカウントされてしまうので、これらの削除
・集計ブックの後ろ2枚のシートはカウント数に加えないのでこれらの文字数の削除

いろいろ聞いてしまってすみません。できれば、よろしくお願いします。

【12784】Re:VBAで文字数カウントしたいのですが(...
発言  ichinose  - 04/4/14(水) 19:09 -

引用なし
パスワード
   ▼ima さん:
こんばんは。

>
>集計ブックを見て、やはり文字数カウントの合計値がほしいと思ったのですが、一連の動作で、集計ブックに新しいシートを追加して、各シートのC列(文字数カウント列)をコピー、総合計を出すというのは可能でしょうか?
>下記の箇所を手作業で文字数カウントを修正する必要があり、このシート上でできればよいのですが。。
>・解答欄が空白の場合、「O」が返り、文字数が「1」とカウントされてしまうので、これらの削除

ここまでは、わかりました。数式の変更で何とかなりそうです!!


>・集計ブックの後ろ2枚のシートはカウント数に加えないのでこれらの文字数の削除

問題は、↑・・、何となくわかるようでわかりません!!
私が想像している仕様であれば簡単な修正でOKみたいなのですが・・・。

詳しく、出来れば、最初の投稿のように例を示して頂けますか?

【12802】Re:VBAで文字数カウントしたいのですが(...
質問  ima  - 04/4/15(木) 13:42 -

引用なし
パスワード
   ▼ichinose さん:

こんにちは。説明不足ですみません。前回説明しなかったのですが、「元ブック」のA列には不定数(X名)の質問があり、最後の質問の次の行には「注記」、その次の行(最終行)には「回答者」が来ます。最終的に文字数としてカウントするのは各質問の回答の文字数だけなので、教えていただいたコードの段階でこの「注記」および「回答者」に記入された文字をカウントをしないようにするか、カウントしても最終的に合計を出す段階で集計に加えられないようにしたいのです。

元ブック-Sheet1(一人目)      元ブック-Sheet2(二人目)…SheetXまである    
  A       B            A    B
1 Q1      ○○○(文字列)   1 Q1    ●●●●
2 Q2      △△△△       2 Q2    ■■
3 Q3      ◇◇         3 Q3    ▲▲▲
・ ・       ・         ・ ・     ・
・ ・       ・         ・ ・     ・
・ QX(最後の質問)×××       ・ QX    ???
・ 注記     ◎◎         ・ 注記    □□
・ 回答者    AAAA         ・ 回答者   BBBB

ichinoseさんが考えてくださったコードを元ブックで実行すると、下記集計ブックのようになります。

集計ブック-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列        
1    シート名     文字数小計
2    Q1       (上記集計ブック-Sheet1のC列の合計値)
3    Q2       (Sheet2のC列の合計値)
・    ・          ・
・    ・          ・    
z    QX       (最後の質問のSheetのC列の合計値)
z+1           (B2:Bzの総計)  

集計ブックの各シートのC列は修正した値を手入力する場合があるので(例えば、文字列にスペースが含まれていると1文字としてカウントしてしまうので、1文字削除するとか、誤字脱字があった場合の文字数の増減など)、C列の値を変更した場合、変更した値が反映される総計になればベストなのですが、無理そうなら手作業で行うつもりです。なお、前回質問したとおり、「回答」が空欄の場合「O」となり1文字としてカウントされる件は数式の変更で可能なのでしょうか?

本当に細かいところまで聞いてしまってすみません。まだまだ初心者で教えてもらったコードをひとつひとつ解読して「なるほど!」と納得しているレベルですので・・希望はあっても自分ではどこから手をつけていいのかわからなくて、ichinoseさんには感謝しています。

【12814】Re:VBAで文字数カウントしたいのですが(...
回答  ichinose  - 04/4/15(木) 21:32 -

引用なし
パスワード
   ▼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列        
>1    シート名     文字数小計
>2    Q1       (上記集計ブック-Sheet1のC列の合計値)
>3    Q2       (Sheet2のC列の合計値)
>・    ・          ・
>・    ・          ・    
>z    QX       (最後の質問のSheetのC列の合計値)
>z+1           (B2:Bzの総計)  

ほぼ、↑のように集計されるはずです。
数式をそのまま残しておきましたので、
例えば、集計ブックのQ1のB列(回答)を修正した場合、
C列の文字数に反映しますし、トータルシートの合計値も変更されるように
してあります。


>説明不足ですみません。
いいえ、これだけの仕様を提示して頂きました。
わかりやすかったですよ!!(まっ、これで仕様と違ったら、私の読解力不足です)

私が書いたコードは、せいぜい60ステップ程度ですが、
そのための仕様書となったら、最初の投稿と合わせてこれだけ書かなければならないということですよね?

この手の質問は、「仕様書を書く」勉強になるかも?

何はともあれ、確認して下さい。

【12839】Re:VBAで文字数カウントしたいのですが(...
質問  ima  - 04/4/16(金) 17:29 -

引用なし
パスワード
   ▼ima さん:
こんにちは。ありがとうございます!ほぼ、ほぼ完成です。より理想に近づけるため、後は自力で修正しようとしたのですが…最後の1ステップ?で止まってしまいました。もう少しだけ診ていただけるでしょうか?

直したかったのは、下記の様に、1.元ブックの「注記」(A列最後から2番目の項目)も集計ブックに載せ(C列の「文字数」はなくてもよい)にし

元ブック-Sheet1(一人目)            
     A    B                
1    Q1    ○○○(文字列)          
2    Q2    △△△△            
3    Q3    ◇◇                            
・    ・
・    ・                
・    QX(最後の質問)×××        
・    注記    ◎◎            
・    回答者 AAAA         

集計ブック-「注記」のSheet(最後のシート)
     A列        B列        C列
1    シート番号    回答        文字数
2     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 連日時間を割いてくださってありがとうございます。また、本当に親切にお答えくださって感謝しています。おっしゃるとおり、コードを比較するだけも大変勉強になります。

【12840】Re:VBAで文字数カウントしたいのですが(...
発言  ima  - 04/4/16(金) 17:33 -

引用なし
パスワード
   追記です。冒頭「imaさん」のままになっていて失礼しました。正しくは「ichinoseさん」です。

【12861】Re:VBAで文字数カウントしたいのですが(...
発言  ichinose  - 04/4/17(土) 11:50 -

引用なし
パスワード
   ▼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 連日時間を割いてくださってありがとうございます。また、本当に親切にお答えくださって感謝しています。おっしゃるとおり、コードを比較するだけも大変勉強になります。
私が確認した限りでは、上記の一箇所の訂正でよいと思いますが・・・。

【12910】Re:VBAで文字数カウントしたいのですが(...
お礼  ima  - 04/4/19(月) 16:23 -

引用なし
パスワード
   ▼ichinose さん:
こんにちは。

最後まで面倒を見てくださってありがとうございました。おかげさまで思ったとおりの作業が高速でできるようになりました。(テストファイル上ですが)
下記ご指摘くださった点、まったくの見落としでした。

また何かありましたら、このサイトに来ますので、そのときはよろしくお願いします。
本当にありがとうございました。
    
>> .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」は消さない

12002 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free