Excel VBA質問箱 IV

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

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


9775 / 13645 ツリー ←次へ | 前へ→

【25480】VBAプログラムの間違いを指摘して欲しいのですが 学生 05/6/1(水) 20:23 質問[未読]
【25483】Re:VBAプログラムの間違いを指摘して欲し... ponpon 05/6/1(水) 22:14 発言[未読]
【25519】Re:VBAプログラムの間違いを指摘して欲し... 学生 05/6/2(木) 20:54 質問[未読]
【25484】Re:VBAプログラムの間違いを指摘して欲しい... ichinose 05/6/1(水) 22:22 発言[未読]
【25489】Re:VBAプログラムの間違いを指摘して欲しい... 学生 05/6/2(木) 8:12 お礼[未読]
【25492】Re:VBAプログラムの間違いを指摘して欲しい... Jaka 05/6/2(木) 10:44 回答[未読]
【25518】Re:VBAプログラムの間違いを指摘して欲しい... 学生 05/6/2(木) 20:50 お礼[未読]
【25521】Re:VBAプログラムの間違いを指摘して欲しい... 学生 05/6/2(木) 21:36 質問[未読]
【25525】Re:VBAプログラムの間違いを指摘して欲しい... ichinose 05/6/3(金) 9:22 発言[未読]
【25542】Re:VBAプログラムの間違いを指摘して欲しい... 学生 05/6/3(金) 21:42 お礼[未読]

【25480】VBAプログラムの間違いを指摘して欲しい...
質問  学生  - 05/6/1(水) 20:23 -

引用なし
パスワード
   無二の親友から以下のプログラムのどこに間違いがあるのか?
聞かれたのですが、よくわからないのです。
どなたか、助け舟を出して頂けないでしょうか?
最初にエラーが出るのは、
 Application.Workbooks(bookname).Select
が黄色のラインがかかってしまうのですが…。
本来なら、本人が質問するのが筋だと思いますが、
日本人ではないので、代理として私がお願いしました。よろしくお願いします。

Sub Q4()
Dim mydata() As Variant
Dim bookname As String, newbookname As String, i As Integer
Dim j As Integer, a As Integer, z As Integer, y As Integer, NoSheets As Integer
 
  bookname = InputBox("Please inter data workbook's name")
   Application.Workbooks.Open (bookname)
  
  NoSheets = Application.Worksheets.Count
  'MsgBox NoSheets
 
  Application.SheetsInNewWorkbook = 3
  Application.Workbooks.Add
   newbookname = InputBox("Please inter new workbook's name")
  ActiveWorkbook.SaveAs newbookname
 
 
  Application.Workbooks(bookname).Select
 
Dim DataArray() As Variant
Dim Counter As Integer
'Dim NoSheets As Integer
Dim RowNo As Integer
Dim ColNo As Integer
Dim Address As String
Dim StringNo As Integer
Dim NumNo As Integer, sum As Variant
'Dim a As Integer, z As Integer, y As Integer

RowNo = 1
ColNo = 1
Address = "R" & RowNo & "C" & ColNo

Application.Workbooks.Add

NoSheets = Application.Worksheets.Count

ReDim DataArray(1 To NoSheets)

For Counter = 1 To NoSheets

  DataArray(Counter) = Application.Worksheets(Counter).Cells(RowNo, ColNo).Value
  ' You cannot use Range because it is confined to an A1 address style
  
    If TypeName(DataArray(Counter)) = "String" Then
      StringNo = StringNo + 1
    End If
    
    If IsNumeric(DataArray(Counter)) Then
      NumNo = NumNo + 1
    End If
  
  ' Code for sum in Summary sheet goes here
  ReDim mydata(1 To 10, 1 To 10) As Variant
    For z = 1 To 10
      For y = 1 To 10
        'For a = 1 To NoSheets
          Sheets(Counter).Select
          mydata(z, y) = Sheets(Counter).Cells(z, y).Value
          sum = mydata(z, y) + Sheets(Counter).Cells(z, y).Value
        'Next a
      Next y
    Next z
  
  Application.Workbooks(newbookname).Selected
  Cells(z, y) = sum
  
   If NumNo = 0 Then Cells(z, y) = "No Data"
  
Next Counter
 

End Sub

【25483】Re:VBAプログラムの間違いを指摘して欲し...
発言  ponpon  - 05/6/1(水) 22:14 -

引用なし
パスワード
   こんばんは。
詳しく見ていないので、よくわかりませんが、
以下のようにすると最後まで走るようですが・・・

>  bookname = InputBox("Please inter data workbook's name")
   Application.Workbooks.Open (bookname & ".xls")
                             ↑
                            追加 

> newbookname = InputBox("Please inter new workbook's name")
  ActiveWorkbook.SaveAs newbookname & ".xls"
                          ↑
                         追加 

  Application.Windows(bookname & ".xls").Activate
                      ↑    ↑
                     追加   変更

  Application.Windows(newbookname & ".xls").Activate
                       ↑     ↑
                       追加   変更
  Cells(z, y) = sum

【25484】Re:VBAプログラムの間違いを指摘して欲し...
発言  ichinose  - 05/6/1(水) 22:22 -

引用なし
パスワード
   ▼学生 さん:
こんばんは。
これね、テスト問題だとしたら
結構、難しい問題ですよ!!

だって、

 ・プログラムの仕様はわからない
 ・アルゴリズムが正しいのかもわからない

まず、下のコードが何をしてくれるコードなのか
記述して下さい。

この時、文章だけでは伝わらない又は、わかりづらいと思ったら、
具体例を挙げて記述して下さい。


> Application.Workbooks(bookname).Select
>が黄色のラインがかかってしまうのですが…。

これは、WorkbookオブジェクトにSelectというメソッドがないからです。
Activateに変えてみてください。

他にもありそうですが・・・。

>
>Sub Q4()
>Dim mydata() As Variant
>Dim bookname As String, newbookname As String, i As Integer
>Dim j As Integer, a As Integer, z As Integer, y As Integer, NoSheets As Integer
> 
>  bookname = InputBox("Please inter data workbook's name")
>   Application.Workbooks.Open (bookname)
>  
>  NoSheets = Application.Worksheets.Count
>  'MsgBox NoSheets
> 
>  Application.SheetsInNewWorkbook = 3
>  Application.Workbooks.Add
>   newbookname = InputBox("Please inter new workbook's name")
>  ActiveWorkbook.SaveAs newbookname
> 
> 
>  Application.Workbooks(bookname).Select
> 
>Dim DataArray() As Variant
>Dim Counter As Integer
>'Dim NoSheets As Integer
>Dim RowNo As Integer
>Dim ColNo As Integer
>Dim Address As String
>Dim StringNo As Integer
>Dim NumNo As Integer, sum As Variant
>'Dim a As Integer, z As Integer, y As Integer
>
>RowNo = 1
>ColNo = 1
>Address = "R" & RowNo & "C" & ColNo
>
>Application.Workbooks.Add
>
>NoSheets = Application.Worksheets.Count
>
>ReDim DataArray(1 To NoSheets)
>
>For Counter = 1 To NoSheets
>
>  DataArray(Counter) = Application.Worksheets(Counter).Cells(RowNo, ColNo).Value
>  ' You cannot use Range because it is confined to an A1 address style
>  
>    If TypeName(DataArray(Counter)) = "String" Then
>      StringNo = StringNo + 1
>    End If
>    
>    If IsNumeric(DataArray(Counter)) Then
>      NumNo = NumNo + 1
>    End If
>  
>  ' Code for sum in Summary sheet goes here
>  ReDim mydata(1 To 10, 1 To 10) As Variant
>    For z = 1 To 10
>      For y = 1 To 10
>        'For a = 1 To NoSheets
>          Sheets(Counter).Select
>          mydata(z, y) = Sheets(Counter).Cells(z, y).Value
>          sum = mydata(z, y) + Sheets(Counter).Cells(z, y).Value
>        'Next a
>      Next y
>    Next z
>  
>  Application.Workbooks(newbookname).Selected
>  Cells(z, y) = sum
>  
>   If NumNo = 0 Then Cells(z, y) = "No Data"
>  
>Next Counter
> 
>
>End Sub

【25489】Re:VBAプログラムの間違いを指摘して欲し...
お礼  学生  - 05/6/2(木) 8:12 -

引用なし
パスワード
   御回答頂きましてありがとうございます。
まる投げしてしまったようですみませんでした。
本人にどういった問題なのかもう一度聞いてみたいと思います。

【25492】Re:VBAプログラムの間違いを指摘して欲し...
回答  Jaka  - 05/6/2(木) 10:44 -

引用なし
パスワード
   こんにちは。

ichinose さんにつけたし。

>bookname = InputBox("Please inter data workbook's name")
これは、プルパスで取得しているんですか?
もしフルパスなら、開いているブックに対して、フルパスで操作しようとしての操作は出来ません。
ブックを開いた時に左上に(なんとかバー、名前忘れた)表示されているブック名で操作しないとダメです。
Dir関数が使える位置の(余り深くない回想)ファイルなら

Application.Workbooks(Dir(bookname)).Activate

とするか、

フルパスからブック名だけ(Book1.xlsなど)を取り出しそれを使う。
もっとも開いてた直後に ActiveWorkbook.Name でも取れますが.....。

【25518】Re:VBAプログラムの間違いを指摘して欲し...
お礼  学生  - 05/6/2(木) 20:50 -

引用なし
パスワード
   ▼Jaka さん:
有難うございます。インプットはc:\からいれております。

【25519】Re:VBAプログラムの間違いを指摘して欲し...
質問  学生  - 05/6/2(木) 20:54 -

引用なし
パスワード
   ▼ponpon さん:
有難うございます。
試してみたのですが、

インデックスが有効範囲にありません…と表示されてしまうのですが…。
一体何が原因なのでしょうか?

【25521】Re:VBAプログラムの間違いを指摘して欲し...
質問  学生  - 05/6/2(木) 21:36 -

引用なし
パスワード
   ▼ichinose さん:
これが問題文です。

以下のマクロを記述しなさい。
使用者にワークブック名を求める。妥当なワークブック名を入力するものと仮定してよい。

現在のディレクトリからそのワークブックを開き、アクティブにする。

どのシートにおいても、A1:J10のセル範囲に数字と文字のセットを入れる。シート数は変化させても良いが、どのシートにもA1:J10の範囲にテーブルを持つようにする。

使用者に対して、新しいワークブックの名前を求め、この名前でワークブックを作成することを求める。Summaryと呼ばれる1つのワークシートだけがあることを確実にしなさい。使用者が妥当なワークシート名を入力して、そのワークブックは存在しないことを想定しなさい。

Summaryシートのどのセルにも、元のワークブックの一致するセルの数値の合計を表示させなさい。合計を計算する際には、どんな文字でも無視しなさい。
文字が含まれている場合には“No Data”と表示させなさい。

全体の合計を計算してこれをメッセージボックスで使用者に報告しなさい。また、数字と文字の数のトータルも報告しなさい。

元のワークブックと新しいワークブックはともに現在のディレクトリに保存して閉じなさい。

あなたのマクロにはなからず、ホットキーとコマンドボタンを付けて実行できるようにしなさい。

【25525】Re:VBAプログラムの間違いを指摘して欲し...
発言  ichinose  - 05/6/3(金) 9:22 -

引用なし
パスワード
   ▼学生 さん:
おはようございます。

指定されたブックの全シートのセルA1〜J10の範囲のそれぞれのセルの合計値を
別ブックに集計表として作成しなさい という事でしょうか?

'======================================================================
Sub main()
  Dim f_name As Variant
  Dim check_book As Workbook
  Dim rngadd As String
  Dim save_book As Workbook
  Dim savenm As Variant
  Dim shtnm As Variant
  '
  f_name = Application.GetOpenFilename("(*.xls),*.xls", , "please select open-bookname")
 
  If UCase(TypeName(f_name)) = UCase("boolean") Then Exit Sub
  Set check_book = Workbooks.Open(f_name)
  With check_book
   rngadd = "[" & .Name & "]" & .Worksheets(1).Name & ":" & _
          .Worksheets(.Worksheets.Count).Name & "!A1"
   End With
  savenm = Application.GetSaveAsFilename("", "(*.xls),*.xls", , "please input save-book-name")
  If UCase(TypeName(savenm)) = UCase("boolean") Then Exit Sub
  Application.SheetsInNewWorkbook = 1
  Set save_book = Workbooks.Add
  With save_book
   With .Worksheets(1).Range("a1:j10")
     .Formula = "=IF(counta(" & rngadd & ")-count(" & rngadd & ")>0,""No data"",SUM(" & rngadd & "))"
     .Value = .Value
     shtnm = Application.InputBox("please input sheet-name")
     If UCase(TypeName(shtnm)) = UCase("boolean") Then
      shtnm = "Summary"
      End If
     On Error Resume Next
     .Parent.Name = shtnm
     If Err.Number <> 0 Then .Parent.Name = "Summary"
     On Error GoTo 0
     End With
   Application.DisplayAlerts = False
   .SaveAs savenm
   Application.DisplayAlerts = True
   MsgBox "Total : " & Application.Sum(.Worksheets(1).Range("a1:j10"))
   End With
  save_book.Close False
  check_book.Close False
End Sub

数値の数と文字の数は、出していませんから、考えてみて下さい。
(コード内でそれを計算する数式は使っています)

【25542】Re:VBAプログラムの間違いを指摘して欲し...
お礼  学生  - 05/6/3(金) 21:42 -

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

本当に有難うございました。
実は私の友人はオーストラリアの大学院で金融のマスターをとるべく勉強しているのですが、向こうの授業はまず何も教えずに課題を出してやってこい!といってくるみたいです。学生の抗議で課題提出期限が引き伸ばされたそうです。

僕は、VBAはカジッタ程度しかわからないので、ちんぷんかんぷんなのですが、本人に届けてみたいと思います。友人の代わりに、また、私からもお礼を申し上げます。有難うございました。

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