[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『８部門から送られてくるデータを配布名簿として自動的に作成したい』 （ととろ）
１．ExcelVBAを使って、８部門から送られてくるデータシートを一つの配布名簿シートへ、
自動的に取り込む（転記）ようにしたい。
※8部門から送られてくるデータシートは、配布名簿シートと同じブックに取り込み（複写）ます。
２．データシートのデータ項目は１１項目あります。転記元の内容は変わることはありますが（見出しを除く）、
転記先の配布名簿シートの見出し部分の１１項目は固定で変わることはありませんので、転記開始行は２行目
から転記開始となるようにしたいです。
３．８部門から送られてくるデータシートを選択した（単一（シート毎））順に選ぶか、一括（全選択（８部門＠８シート分）
選択したら処理ボタンを押すことで転記する処理を行えるようにしたいです。
４．配布名簿に取り込む（転記）する動作は、配布番号が変わるまで転記を行い、配布番号が変わったら
配布担当者の件数を算出し表示し、終わるまで繰り返すようにしたいです。
５．始めに配布名簿シートへ転記した処理の繰り返しが終わったら、残りのデータシートの転記を４.と同じように繰り返し、
８部門分のデータシートの転記が終わるまで繰り返し処理を出来る様にしたいです。
６．データシートの転記の順序については、データシート１の次にデータシート３とかデータシート７等
順不同な処理は、複雑すぎて保守が難しくなると思うので、必ず、データシート１から順に行いたい
です。
７．毎年（毎年度）この作業を行えるようにしたいです。
［ｼｰﾄ構成］
１．操作手順書
２．メニューシート
３．データシート※８部門分＠８シート
［機能］
１．データシートを選択できる方式にしたいです。
※単独または一括処理いずれか出来る方法があれば、出来るようにしたいです。
２．処理開始ボタン ※データシート選択後、処理ボタンを押下することで処理（転記）
を開始しするようにしたいです。
３．保存ボタン
※配布名簿シートを別のブックに保存することで、内容に誤りがあった場合でも、
何回でも処理することを可能にしたいです。
４．終了ボタン
※ExcelBookを全て閉じるようにしたいです。
［配布シートのレイアウト］ Ｎｏ：Ｄａｔａ１：Ｄａｔａ２：Ｄａｔａ３：氏名：Ｄａｔａ５：Ｄａｔａ６：住所：Ｄａｔａ８：Ｄａｔａ９：担当者名 １ asjsjdk fjtrutur fnfhjryur 安恵 jkfhjfurui kfdjfghush 東京 kdfgsfhgwk ghkshgushg 配布太郎 １ asjsjdk fjtrutur fnfhjryur 豚平 jkfhjfurui kfdjfghush 京都 kdfgsfhgwk ghkshgushg 配布穂希 １ asjsjdk fjtrutur fnfhjryur 庵叙 jkfhjfurui kfdjfghush 大阪 kdfgsfhgwk ghkshgushg 配布三郎 １ asjsjdk fjtrutur fnfhjryur 光明 jkfhjfurui kfdjfghush 長野 kdfgsfhgwk ghkshgushg 配布権蔵 １ asjsjdk fjtrutur fnfhjryur 尊保 jkfhjfurui kfdjfghush 群馬 kdfgsfhgwk ghkshgushg 配布菊代 ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ＸＸＸ件
［Data条件］
この処理は、年度が変わるたびに作成するので、８部門から送られてくるデータシートの内容は毎年増減しますので、
これを考慮したい。
［今まで、アドバイスいただいて作成したコード］
・ Sub 広報用シート編集処理2のところで、８データシートを全て転記しようとすると、８データシート全てにおいて配布担当者件数が表示されたり、
件数が表示されなかったりとか、転記すべきデータシートが抜けていたりという現象が発生しているので、是非ともアドバイスを頂きたい
です。
'対象シート表示処理
Private Sub 対象シート表示_Click()
' If 終了処理_Click() = True Then
' Call 終了
' Else
With Me.ListBox1
Application.DisplayStatusBar = True
Application.StatusBar = "マクロ実行中です…。"
.MultiSelect = fmMultiSelectMulti
.ListStyle = fmListStyleOption
.List = Split(WshNames)
End With
' End If
End Sub
'広報用シート編集処理１
Private Sub 広報用シート編集_Click()
Dim lastRow As Long
Dim i As Integer
Dim isFirstProc As Boolean
ThisWorkbook.Sheets("広報用").Cells.ClearContents
With Me.ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
If Not isFirstProc Then
isFirstProc = True
ThisWorkbook.Sheets("広報用").Range("A1:K1").Value _
= ThisWorkbook.Sheets(.List(i)).Range("A1:K1").Value
End If
Call 広報用シート編集処理2(.List(i))
End If
Next i
End With
End Sub
'広報用シート編集処理２
Sub 広報用シート編集処理2(SheetNameToProc As String)
Dim i&, j&, n&, S$, No$
Dim Su&, v, w
v = ThisWorkbook.Sheets(SheetNameToProc).Cells(1, 1).CurrentRegion.Value
ReDim w(2 To UBound(v) * 2, 1 To 11) '展開用配列準備
' For i = 1 To 11
' w(1, i) = v(1, i)
' Next
No = v(2, 1): n = 1
For i = 2 To UBound(v)
n = n + 1
If v(i, 1) = No Then
Su = Su + 1
Else
w(n, 11) = Su & " 件": Su = 1: No = v(i, 1)
n = n + 1
End If
For j = 1 To 11
w(n, j) = v(i, j)
Next
Next
n = n + 1
w(n, 11) = Su & " 件"
n = n + 1
' w(n, 10) = "合計": w(n, 11) = (UBound(v) - 1) & " 件"
With ThisWorkbook.Sheets("広報用")
.Cells(Rows.Count, "J").End(xlUp).EntireRow.Cells(1, 1).Offset(1, 0).Resize(n, 11).Value = w
End With
End Sub
'広報用シート編集処理３
Private Function WshNames()
Dim ws As Worksheet
Dim strWshName As String
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "運用について", "１．運用の流れ", _
"２．配布名簿データーシートの書式統一", _
"作成手順", "メニュー", "広報用"
'do nothing
Case Else
strWshName = strWshName & " " & ws.Name
End Select
Next
WshNames = Trim(strWshName)
End Function
'広報用データシート保存処理
Private Sub 保存_clic()
Sheets("広報用").Select
Sheets("広報用（写）").Copy
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\xxxx\My Documents\Bookxx.xls", FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close
End Sub
'終了処理
Private Sub 終了処理_Click()
Application.StatusBar = False
Application.StatusBar = "マクロ実行終了しました。"
'広報用シートのデータクリア
For i = 6 To 6
Worksheets(i).Range("A2:K1048576").Value = ""
Next
Sheets("メニュー").Select
Range("A1").Select
'不要なシートの再表示
' Sheets("メニュー").Select
' Range("A1").Select
'
Dim k As Integer
For k = 1 To 4
Sheets(k).Visible = True '---ユーザーからは全く見えない
Next k
'全ての Book を保存して閉じる
'最後に Excel も終了する
Dim w As Workbook
'全ての Book を保存する
For Each w In Workbooks
w.Save
Next
'Excel を終了する
Application.Quit
MsgBox "処理を終了します。 お疲れ様でしたしましたm(_ _)m"
'Book を閉じる
ThisWorkbook.Close False
End Sub
［Excel2010］
［Windows7］
上記の内容で、上手く伝わるか自信がありませんが、どうしても完成させたいので、
皆様からのアドバイスを是非頂きたいので、よろしくお願い致します。
こんばんは
なかなか伝わらないですね。
With ThisWorkbook.Sheets("広報用")
.Cells(Rows.Count, "J").End(xlUp).EntireRow.Cells(1, 1).Offset(1, 0).Resize(n, 11).Value = w
End With
"J"でいいのですか？ ' w(n, 10) = "合計": w(n, 11) = (UBound(v) - 1) & " 件" ってコメントアウトされているので、"K"のような気がします。
もし"J"なら、w(n, 10) = "合計"は生かしておかないとまずいのでは？
コードを見る限り「配布番号」はA列で、しかもソートされているか同じ配布番号は行が連続していますよね？ とすれば、集計使っても良さそうです。
Sub 広報用シート編集処理2(SheetNameToProc As String)
Dim r As Range
Dim t As Range
Dim s As Range
Application.DisplayAlerts = False
With ThisWorkbook.Sheets(SheetNameToProc)
.Cells(1, 1).CurrentRegion.Subtotal _
GroupBy:=1, Function:=xlCount, TotalList:=Array(11), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Set t = .Cells(1, 1).CurrentRegion.Offset(1)
Set r = ThisWorkbook.Sheets("広報用").Cells(Rows.Count, "J").End(xlUp).EntireRow.Cells(2, 1)
r.Resize(t.Rows.Count - 2, t.Columns.Count).Value = t.Value
On Error Resume Next
For Each s In r.Offset(, 1).Resize(t.Rows.Count - 2, 1).SpecialCells(xlCellTypeBlanks).Cells
s.EntireRow.Cells(1, 1).ClearContents
With s.EntireRow.Cells(1, t.Columns.Count)
.Offset(, -1).Value = "合計"
.Value = .Value & "件"
End With
Next
On Error GoTo 0
.UsedRange.RemoveSubtotal
End With
Application.DisplayAlerts = True
End Sub
とか。
（ウッシ）
＞こんばんは
＞なかなか伝わらないですね。
→すみませんm(_ _)m
＞With ThisWorkbook.Sheets("広報用")
＞ .Cells(Rows.Count, "J").End(xlUp).EntireRow.Cells(1, 1).Offset(1, 0).Resize(n, 11).Value = w
＞ End With
＞"J"でいいのですか？
＞' w(n, 10) = "合計": w(n, 11) = (UBound(v) - 1) & " 件"
＞ってコメントアウトされているので、"K"のような気がします。
＞もし"J"なら、w(n, 10) = "合計"は生かしておかないとまずいのでは？
→配布担当者氏名をカウントして件数を表示できればいいので、コメントアウト
しております。
＞コードを見る限り「配布番号」はA列で、しかもソートされているか同じ配布番号は行が連続していますよね？
＞とすれば、集計使っても良さそうです。
→おっしゃる通り、「配布番号」はA列で昇順で且つ行は連続しています。
頑張って、皆様に伝わるよう書いたのですが文才が無く伝わり辛いようですね（汗）
お手数お掛けしてすみませんm(_ _)m
今回の配布名簿作成するまでの流れをもおう一度記載したいと思います。
１．８部門からデータシートが送られてきます。※つまり、データシートは８シートになります。
２．１．を配布名簿作成ブックに取り込み（複写）します。
３．取り込（複写）んだ８シートを転記元として、配布名簿シートを転記先とします。
シートの選択方法は、単体または全選択のどちらか選択できる方式にしたいです。
４．３．の転記先に８シートの内容を全て（見出し部分を除く）を転記します。
５．配布番号は、担当者毎に振られていますので、配布番号が変わったら担当者の件数を表示します。
件数が分かればいいので、合計は表示しなくてもよいと思っています。
６．５．の処理が終ったら、続けて転記を行います。これをデータが無くなるまで行います。
７．６．データシート１を転記先に転記し終ったら、データシート２を次に転記先に転記をします。
これを、データシート８まで繰り返します。
追伸、以下の揮ごうでくくられている箇所のコードで、現在inputboxを使用しいるのですが、
何か他に良い方法がありましたら、皆様からのアドバイスをよろしくお願い致します。
'対象シート表示処理 --------------¬
Private Sub 対象シート表示_Click() ｜
' If 終了処理_Click() = True Then ｜
' Call 終了 ｜
' Else ｜
With Me.ListBox1 ｜
Application.DisplayStatusBar = True ｜
Application.StatusBar = "マクロ実行中です…。" ｜
.MultiSelect = fmMultiSelectMulti ｜
.ListStyle = fmListStyleOption ｜
.List = Split(WshNames) ｜
End With ｜
' End If ｜
End Sub ｜ ｜
'広報用シート編集処理１ ｜
Private Sub 広報用シート編集_Click() ｜
Dim lastRow As Long ｜
Dim i As Integer ｜
Dim isFirstProc As Boolean ｜
ThisWorkbook.Sheets("広報用").Cells.ClearContents ｜
With Me.ListBox1 ｜
For i = 0 To .ListCount - 1 ｜
If .Selected(i) Then ｜
If Not isFirstProc Then ｜
isFirstProc = True ｜
ThisWorkbook.Sheets("広報用").Range("A1:K1").Value _｜
= ThisWorkbook.Sheets(.List(i)).Range("A1:K1").Value ｜
End If ｜
Call 広報用シート編集処理2(.List(i)) ｜
End If ｜
Next i ｜
End With ｜
End Sub----------------------------------------------------------------------
'広報用シート編集処理２
Sub 広報用シート編集処理2(SheetNameToProc As String)
Dim i&, j&, n&, S$, No$
Dim Su&, v, w
v = ThisWorkbook.Sheets(SheetNameToProc).Cells(1, 1).CurrentRegion.Value
ReDim w(2 To UBound(v) * 2, 1 To 11) '展開用配列準備
' For i = 1 To 11
' w(1, i) = v(1, i)
' Next
No = v(2, 1): n = 1
For i = 2 To UBound(v)
n = n + 1
If v(i, 1) = No Then
Su = Su + 1
Else
w(n, 11) = Su & " 件": Su = 1: No = v(i, 1)
n = n + 1
End If
For j = 1 To 11
w(n, j) = v(i, j)
Next
Next
n = n + 1
w(n, 11) = Su & " 件"
n = n + 1
' w(n, 10) = "合計": w(n, 11) = (UBound(v) - 1) & " 件"
With ThisWorkbook.Sheets("広報用")
.Cells(Rows.Count, "J").End(xlUp).EntireRow.Cells(1, 1).Offset(1, 0).Resize(n, 11).Value = w
End With
End Sub
'広報用シート編集処理３
Private Function WshNames()
Dim ws As Worksheet
Dim strWshName As String
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "運用について", "１．運用の流れ", _
"２．配布名簿データーシートの書式統一", _
"作成手順", "メニュー", "広報用"
'do nothing
Case Else
strWshName = strWshName & " " & ws.Name
End Select
Next
WshNames = Trim(strWshName)
End Function
'広報用データシート保存処理
Private Sub 保存_clic()
Sheets("広報用").Select
Sheets("広報用（写）").Copy
ウッシ様以外の方でも、こういう方法があるよ♪等、良い方法がありましたらアドバイスいただけると
大変ありがたいので、よろしくお願い致します。（ととろ）
こんにちは
>w(n, 10) = "合計" は「合計」という文字をセットしているだけで、10列目つまりJ列の最終行を判定する ためにセットされていたのでは？ これをセットせずにJ列で最終行を判定すると、せっかくセットした件数が次のシート のデータで上書きされます。
集計案については、結局レスした内容は的外れだったのかな？ 結果はどうなったのかな。
現時点のコードがまともに動いてないなら、最初から作り直した方がいいですね。 このコードのどこがダメなのか回答者側で検証して直すのは手間ですし。
あとは、inputbox を使用している部分だけ直せばいいのかな？ 「転記すべきデータシートが抜けていたり」という現象はまだ続いているのかな？
（ウッシ）
ウッシ様、最初のフォローを実施し、只今検証中です。
こんにちは
>w(n, 10) = "合計" > は「合計」という文字をセットしているだけで、10列目つまりJ列の最終行を判定する > ためにセットされていたのでは？ > これをセットせずにJ列で最終行を判定すると、せっかくセットした件数が次のシート >のデータで上書きされます。 →ウッシ様のおっしゃる通りでした。（汗） →とても見やすくて素敵な結果を見て検証しています。
>集計案については、結局レスした内容は的外れだったのかな？ >結果はどうなったのかな。 →検証中ですが、「完璧です！！」全て検証が終ったら、ウッシ様のコードを深読みして 今後のVBAスキルアップに役立たせていただきますm(_ _)m
>現時点のコードがまともに動いてないなら、最初から作り直した方がいいですね。 >このコードのどこがダメなのか回答者側で検証して直すのは手間ですし。 →途中経過ですが、とても素敵に完璧に動いてい状況です。（*^_^*）ゞ
>あとは、inputbox を使用している部分だけ直せばいいのかな？ → はい、何か良い方法がありましたら、アドバイスお願い致します。
>「転記すべきデータシートが抜けていたり」という現象はまだ続いているのかな？ → 検証中ですが、完璧な状態であります。検証が終わりましたら、ご報告いたします。
（ととろ）
検証が完了いたしました。
試験の方法としては、８部門分のシート（８シート）全て選択して処理を行いました。
結果、件数表示及び転記内容は問題なく処理されておりました。
件数の未表示や、転記元のシートの抜けはございませんでした。
本当に、ありがとうございましたm(_ _)m
残りは、inputboxに変るものの方法と、保存ボタンの機能だけになりました。
是非、アドバイスを頂けるとありがたいです。
よろしくお願い致します。（ととろ）
こんにちは
InputBox ではなくて、ListBox 使っているのですよね？
どうして変更したいのですか？
保存ボタンの機能は 「保存_clic」をコピーし別名にして、"広報用"を"配布名簿"に変更し保存名を年月日時間を ファイル名として使える形に フォーマットしてつけてあげるように変更すればいいですよ。
(ウッシ）
下記のコードで試みてるのですが、動かなくてなんでかなぁ〜って感じです（汗）
Sub 保存()
Worksheets(Worksheets.Count).Select
If ActiveSheet.Name = "メニュー" Then
Worksheets(Worksheets.Count + 1).Select
End If
If ws.Name <> "メニュー" Then
ws.Select (False)
End If
Next
ActiveWindow.SelectedSheets.Copy
Application.Dialogs(xlDialogSaveAs).Show
End Sub
コーディングが間違ってるから動かないのは当たり前ですよね（苦笑）
（ととろ）
こんばんは
今ListBoxで動いているならそれでいいと思いますけど、単体（１シート毎に）で実行するか 一括（全選択）処理するか関係無く選択したシートを処理するようにするだけでも良ければ 単純化出来ますよね。
また、一括（全選択）処理というのがそのブックのメニューシート以外の全シートの事であればもっと単純に メッセージボックスで処理分岐するだけでも出来ますよね。
'広報用シート編集処理１
Sub 広報用シート編集_Click()
Dim ws As Worksheet
ThisWorkbook.Sheets("広報用").Cells.ClearContents
Select Case MsgBox("選択シートのみ処理の場合「はい」、" & _
"一括処理の場合「いいえ」、" & _
"処理中止の場合「キャンセル」", vbYesNoCancel)
Case vbYes
Call 広報用シート編集処理2(ActiveSheet.Name)
Case vbNo
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "メニュー" '対象外シートを増やす場合はここに追加
'do nothing
Case Else
Call 広報用シート編集処理2(ws.Name)
End Select
Next
Case vbCancel
Exit Sub
End Select
End Sub
Sub 保存()
Dim ws As Worksheet
Dim wb As Workbook
Dim f As Variant
f = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If f = False Then
Exit Sub
End If
Set wb = Workbooks.Add
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "メニュー" '対象外シートを増やす場合はここに追加
'do nothing
Case Else
ws.Copy wb.Worksheets(1)
End Select
Next
Application.DisplayAlerts = False
For Each ws In wb.Worksheets
If ws.UsedRange.Count = 1 Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
wb.SaveAs f, xlNormal
wb.Close
End Sub
こんな感じです。
（ウッシ）
早速のフォローありがとうございました。
完璧に仕上がりました！(T_T)←嬉し泣きです。
手とり足とり、素人同然の私にお付き合い頂き、また、ご教授頂き本当にありがとうございました。
これからも、VBAを精進していきたいと思います。
本当に、ありがとうございましたm(_ _)m
そして、「ウッシ様や、ここに集まられているExcelのSpecialistである皆様方」に、
厚く御礼申し上げますと共に、また、壁にぶち当たったときは、よろしくお願い致します。
皆様、本当にありがとうございました。（ととろ）
クローズしたのですが、少しだけアドバイスをお願いしたく以下に内容を記載します。
単体処理にて、「実行時エラー'1004'Rangeクラスのメソッドが失敗しました。」
と言うメッセージが出て色々やっては見たのですが、CELLをセットの部分で不具合が出ているのでしょうか？
併せて、メッセージボックスのサイズが、ExcelBookを開く度に小さくなってしまいます。
メッセージボックスのプロパティで色々試してみたのですが、☑が出来なくなったり等、上手くいかないので
何か、「ここをいじればOK♪」的なアドバイスを頂けたらありがたいです。
クローズしたのに申し訳御座いませんが、アドバイスいただけたら幸いです。
よろしくお願い致します。（ととろ）
以下、コードです。
'広報用シート編集処理１
Sub 広報用シート編集_Click()
Dim ws As Worksheet
ThisWorkbook.Sheets("広報用").Cells.ClearContents
Select Case MsgBox("選択シートのみ処理の場合「はい」、" & _
"一括処理の場合「いいえ」、" & _
"処理中止の場合「キャンセル」", vbYesNoCancel)
Case vbYes
Call 広報用シート編集処理2(ActiveSheet.Name)
Case vbNo
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "運用について" '対象外シートを増やす場合はここに追加
Case "１．運用の流れ"
Case "２．書式統一"
Case "操作説明"
Case "メニュー"
Case Else
Call 広報用シート編集処理2(ws.Name)
End Select
Next
Case vbCancel
Exit Sub
End Select
End Sub
'広報用シート編集処理１←この箇所は修正前のコードです。こちらにすると単体でも動きます。
' Private Sub 広報用シート編集_Click()
' Dim lastRow As Long
' Dim i As Integer
' Dim isFirstProc As Boolean
' ThisWorkbook.Sheets("広報用").Cells.ClearContents
' With Me.ListBox1
' For i = 0 To .ListCount - 1
' If .Selected(i) Then
' If Not isFirstProc Then
' isFirstProc = True
' ThisWorkbook.Sheets("広報用").Range("A1:K1").Value _
' = ThisWorkbook.Sheets(.List(i)).Range("A1:K1").Value
' End If
' Call 広報用シート編集処理2(.List(i))
' End If
' Next i
' End With
' End Sub
'広報用シート編集処理２
Sub 広報用シート編集処理2(SheetNameToProc As String)
Dim r As Range
Dim t As Range
Dim s As Range
Application.DisplayAlerts = False
With ThisWorkbook.Sheets(SheetNameToProc)
.Cells(1, 1).CurrentRegion.Subtotal _--------------------------------
GroupBy:=1, Function:=xlCount, TotalList:=Array(11), _ |←個々の箇所が黄色
Replace:=True, PageBreaks:=False, SummaryBelowData:=True---------で反転して止まりま
す。
Set t = .Cells(1, 1).CurrentRegion.Offset(1)
Set r = ThisWorkbook.Sheets("広報用").Cells(Rows.Count, "J").End(xlUp).EntireRow.Cells(2, 1)
r.Resize(t.Rows.Count - 2, t.Columns.Count).Value = t.Value
On Error Resume Next
For Each s In r.Offset(, 1).Resize(t.Rows.Count - 2, 1).SpecialCells(xlCellTypeBlanks).Cells
s.EntireRow.Cells(1, 1).ClearContents
With s.EntireRow.Cells(1, t.Columns.Count)
.Offset(, -1).Value = "合計"
.Value = .Value & "件"
End With
Next
On Error GoTo 0
.UsedRange.RemoveSubtotal
End With
Application.DisplayAlerts = True
End Sub
（ととろ） 2013/10/18(金) 18:44
こんばんは
エラーになった時にデバッグした状態で、SheetNameToProcにマウスポインタを合わせて 内容を確認して下さい。
マクロを終了してから、そのシートを開いて手作業で集計が出来るか確認して下さい。
「実行時エラー'1004'Rangeクラスのメソッドが失敗しました。」 というエラーが再現出来ない のでなんとも言えないですが、シートのデータの状態によってエラーになる可能性は有ります。
また、修正前のコードで動くという事は、SheetNameToProcにセットしているシート名が違う という可能性も有ります。
こちらではととろさんの環境が無いので確認することは出来ないのでエラーになった場合は ご自分で調べるスキルを身に付けて下さい。
>メッセージボックスのサイズが、ExcelBookを開く度に小さくなってしまいます。 全くなんの事か分かりません。 エラーメッセージの事では無いですよね？
（ウッシ） 2013/10/18(金) 21:01
早速のフォローありがとうございます。
エラーになった時にデバッグした状態で、SheetNameToProcにマウスポインタを合わせて 内容を確認して下さい。 マクロを終了してから、そのシートを開いて手作業で集計が出来るか確認して下さい。 「実行時エラー'1004'Rangeクラスのメソッドが失敗しました。」 というエラーが再現出来ない のでなんとも言えないですが、シートのデータの状態によってエラーになる可能性は有ります。 また、修正前のコードで動くという事は、SheetNameToProcにセットしているシート名が違う という可能性も有ります。 こちらではととろさんの環境が無いので確認することは出来ないのでエラーになった場合は ご自分で調べるスキルを身に付けて下さい。
→ がんばります(^_^)ゞ
メッセージボックスのサイズが、ExcelBookを開く度に小さくなってしまいます。 全くなんの事か分かりません。
エラーメッセージの事では無いですよね？ →対象シートを表示するリストボックスでした。
間違えてしまいました。すみません。(^_^;)
（ととろ） 2013/10/19(土) 09:23
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.