[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『[[20140621155632]] について』（ななし）
投稿
[[20140621155632]]『元シートをグループ毎に分割する際、テンプレート』（お母さん）
について...
お分かりになる方がいらっしゃいましたら教えてください。
上記のmook様が書かれたコードについてです。「元データの分割判定を行う列」の「分類列 = "C"」に該当する部分のC列のデータですが、直接入力したデータであれば上手くいきます。
ところが、別のファイルからコピーしたデータを値だけ貼り付けて使用すると「実行時エラー アプリケーション定義またはオブジェクト定義のエラーです。」というエラーが出てしまいます。デバッグでは「最終行 = .Cells(Rows.Count, 分類列).End(xlUp).Row」が黄色になっています。
別ファイルからコピーしたデータというのは、C列に数式データが入っており、それを「値だけを貼り付け」したものです。解決方法をお教えください。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
つかぬ事をお聞きしますが、 関係するエクセルファイルの拡張子が混在していませんか？（.xls,.xlsx など新旧混在していないか、と言うことです）
（半平太） 2016/09/29(木) 17:08
そうですか。。。
念のため、上記トラブった時、プログラムを止め、 後記プログラム(test）を実行してみてください。
メッセージが下例のように表示されます。 全部同じ最終行か確認してください。
<例> Book1 最終行→1048576 Book2 最終行→1048576
Sub test()
Dim WB, buf
For Each WB In Workbooks
buf = buf & WB.Name & " 最終行→" & WB.Sheets(1).Rows.Count & vbLf
Next
MsgBox buf
End Sub
（半平太） 2016/09/29(木) 17:49
「Book1(.xlsm) 最終行→1048576」の結果となりました・・・。
（ななし） 2016/09/30(金) 09:05
ありゃ！ ファイルは一つだったんですか。
そう言えば、こんな返信を既にいただいていました。ごめんなさい m(__)m ↓ ＞コピーしたデータは同ファイル内・・・の別シートで作ったものでした
しかし、そこしかこのトラブルになる要素が無いのですけどねぇ。
しつこいようですが、もう一つトライしてください。
＞ 最終行 = .Cells(Rows.Count, 分類列).End(xlUp).Row」が黄色になっています。
それをこうしてみて下さい。やはりトラブるんでしょうか？
↓
最終行 = .Cells(65536, 分類列).End(xlUp).Row
あと、トラブった時、「分類列」に何が入っているか教えてください。
（半平太） 2016/09/30(金) 12:46
ん〜、リンクの飛び先が違っているようで、元質問が判らない〜。 とりあえず、以下のように、ピリオド追加でいかがでしょうか？ （どのシートのRowsなのかを明確にする）
最終行 = .Cells(.Rows.Count, 分類列).End(xlUp).Row （???） 2016/09/30(金) 12:52
お二人の指定してくださったコードをそれぞれ試しましたが駄目でした…。
あら？！リンク先が消えてます…！リンク先ページを参考にして新しく投稿するをしたんですが、私のせいでしょうか〜！！昨日は投稿後リンク先を確認できたのですが…！？申し訳ありません…！ちょっとmook様のデータをコピーして貼らせていただきます。
『シートを項目毎に分割する際、テンプレートを使用する（mook様作）』
'//--------------------------------------------------------
'// 処理：データを種類ごとにシートに分類
'//--------------------------------------------------------
'// 処理するファイル内にマクロを置いて実行してください。
'//--------------------------------------------------------
Option Explicit
'//--------------------------------------------------------
'// ファイルに併せて設定
'//--------------------------------------------------------
Const データシート名 = "Data" '--- 元データシート名
Const 分類列 = "b" '--- 元データの分割判定を行う列
Const データ判定列 = "E" '--- 各シートの最終行を判定する列
Const コピー処理単位行数 = 1 '--- コピー行単位
Const データ開始行 = 2 '--- 各シートのデータ開始行（ヘッダ行＋１）
'//--------------------------------------------------------
'// オプション
'//--------------------------------------------------------
'//-------------------------
'// 1)処理先ファイルの指定
'// True ・・・ 新規ファイルで作成
'// False ・・・ 自ブック内に作成
Const オプション_新規ファイル作成 = False
'//-------------------------
'// 2)追記モードの指定
'// 上記の 1) オプションが False のときのみ有効
'// True ・・・ データを追記 ★注意：2回実行すると同じものが追加されます
'// False ・・・ データ再登録 ★注意：Master シート以外をすべて再作成します
Const オプション_データ追記 = False
'//-------------------------
'// 3)テンプレートファイルの使用の指定
'// True ・・・ テンプレートファイルを使用。True のときは テンプレートファイルパスを指定。
'// False ・・・ データシートをテンプレートシートとして使用
Const テンプレートファイルを使用 = True
Const テンプレートファイルパス = "C:\ひな形リンク"
'//--------------------------------------------------------
Const 作業シート名 = "TMP" '--- 作業用テンプレートシート名
'//--------------------------------------------------------
'// ★アクティブなシートを処理する場合はこちらを実行
'//--------------------------------------------------------
Sub データをシートに分類処理_アクティブWBを処理()
'//--------------------------------------------------------
Dim データWB As Workbook
Dim データWS As Worksheet
Set データWB = ActiveWorkbook
Set データWS = ActiveSheet
データをシートに分類処理 データWB, データWS
End Sub
'//--------------------------------------------------------
'// ★自ブックの定義で規定したシートを処理する場合はこっちを実行（従来版の動作）
'//--------------------------------------------------------
Sub データをシートに分類処理_自ブックを処理()
'//--------------------------------------------------------
Dim データWB As Workbook
Dim データWS As Worksheet
Set データWB = ThisWorkbook
Set データWS = ThisWorkbook.Worksheets(データシート名)
データをシートに分類処理 データWB, データWS
End Sub
'//--------------------------------------------------------
Sub データをシートに分類処理(データWB As Workbook, データWS As Worksheet)
'//--------------------------------------------------------
Dim 最終行 As Long
Dim 出力WB As Workbook
Dim 処理WS As Worksheet
'//--- 開始処理
Application.ScreenUpdating = False
With データWS
最終行 = .Cells(.Rows.Count, 分類列).End(xlUp).Row
If オプション_新規ファイル作成 = True Then
.Copy
Set 出力WB = ActiveWorkbook
出力WB.Worksheets(データWS.Name).Name = 作業シート名
出力WB.Worksheets(作業シート名).Rows(データ開始行 & ":" & Rows.Count).Clear
Else
If オプション_データ追記 = False Then
If MsgBox(データWS.Name & "以外を再作成します。よろしいですか？", vbYesNo) = vbNo Then
Exit Sub
End If
Application.DisplayAlerts = False
For Each 処理WS In データWB.Worksheets
If 処理WS.Name <> データWS.Name Then
処理WS.Delete
End If
Next
Application.DisplayAlerts = True
End If
Set 出力WB = データWB
If テンプレートファイルを使用 = False Then
.Copy after:=データWB.Worksheets(1)
出力WB.Worksheets(2).Name = 作業シート名
出力WB.Worksheets(作業シート名).Rows(データ開始行 & ":" & Rows.Count).Clear
End If
End If
Dim 処理行 As Long
For 処理行 = データ開始行 To 最終行
If .Cells(処理行, 分類列).Value <> "" Then
行追加処理 出力WB, データWS, 処理行, .Cells(処理行, 分類列).Value
End If
Next
End With
'//--- 終了処理
If テンプレートファイルを使用 = False Then
Application.DisplayAlerts = False
出力WB.Worksheets(作業シート名).Delete
Application.DisplayAlerts = True
End If
Application.ScreenUpdating = True
'//--- 表示位置の調整
シート並べ替え処理 出力WB
For Each 処理WS In 出力WB.Worksheets
Application.Goto Reference:=処理WS.Range("A1"), Scroll:=True
Next
出力WB.Worksheets(1).Activate
Application.CutCopyMode = False
End Sub
'//--------------------------------------------------------
Private Sub 行追加処理(出力WB As Workbook, データWS As Worksheet, 対象行 As Long, シート名 As String)
'//--------------------------------------------------------
' コピー先シートにデータをコピー
'---------------------------------
Dim 最終行 As Long
シート確認作成処理 出力WB, シート名
最終行 = 出力WB.Worksheets(シート名).Range(データ判定列 & Rows.Count).End(xlUp).Row + 1
データWS.Rows(対象行 & ":" & 対象行 + コピー処理単位行数 - 1).Copy
出力WB.Worksheets(シート名).Rows(最終行).Insert Shift:=xlDown
End Sub
'//--------------------------------------------------------
Private Sub シート確認作成処理(出力WB As Workbook, シート名 As String)
'//--------------------------------------------------------
' コピー先シートがあるかチェックしなければ作成
'---------------------------------
Dim 作業WS As Worksheet
On Error Resume Next
Set 作業WS = 出力WB.Worksheets(シート名)
On Error GoTo 0
If 作業WS Is Nothing Then
If テンプレートファイルを使用 = True Then
出力WB.Sheets.Add after:=出力WB.Sheets(出力WB.Sheets.Count), Type:=テンプレートファイルパス
Else
出力WB.Worksheets(作業シート名).Copy after:=出力WB.Worksheets(出力WB.Worksheets.Count)
End If
出力WB.Worksheets(出力WB.Worksheets.Count).Name = シート名
End If
End Sub
'//--------------------------------------------------------
' シートを名前順でソート
'---------------------------------
Private Sub シート並べ替え処理(出力WB As Workbook)
Dim シート開始位置 As Long
If オプション_新規ファイル作成 = True Then
シート開始位置 = 1
Else
シート開始位置 = 2
End If
Dim i As Long
Dim j As Long
For i = シート開始位置 To 出力WB.Worksheets.Count - 1
For j = i + 1 To 出力WB.Worksheets.Count
If StrComp(出力WB.Worksheets(i).Name, 出力WB.Worksheets(j).Name) > 0 Then
出力WB.Worksheets(j).Move Before:=出力WB.Worksheets(i)
End If
Next
Next
End Sub
（ななし） 2016/09/30(金) 14:44
'//-------------------------------------------------------- Const データシート名 = "Data" '--- 元データシート名 Const 分類列 = "b" '--- 元データの分割判定を行う列 Const データ判定列 = "E" '--- 各シートの最終行を判定する列 Const コピー処理単位行数 = 1 '--- コピー行単位 Const データ開始行 = 2 '--- 各シートのデータ開始行（ヘッダ行＋１） '//--------------------------------------------------------
元シートのデータはA〜Ｉ列まで3000行くらいありまして、
A列 ナンバー（1〜約3000）の数字。数式で導き出した数字をコピペして値だけ貼り付けている。
B列 東京・大阪などの数種類の文字列（分類列）
C〜Ｉ列 数字や文字列など。ところどころ空欄もあり、データ判定列"E"は空欄のないすべて文字列で埋まっている列を指定した。
以上です。
（ななし） 2016/09/30(金) 14:56
回答でなくて申し訳ない。 編集ボタンがないのになぜ質問・回答が消されているのか。 そのうち管理人さんが復元してくれると思うけど不思議だな。 （bi） 2016/09/30(金) 15:20
こちらでは、現象が再現しないです。
再現手順を示していただかないと、私はこれ以上は対応できません。
申し訳ないです。m(__)m
（半平太） 2016/09/30(金) 16:12
リンク先が消えているのはぜひまた復元されるといいなと思います…！他で検索してもでてこないありがたいコードでしたので…。そしてまたこのコードについてお伺いするかもしれませんがよろしくお願いいたします！
（ななし） 2016/09/30(金) 17:29
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.