[[20160929164131]] 『[[20140621155632]] について』(ななし) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

[[20140621155632]] について』(ななし)

投稿
[[20140621155632]]『元シートをグループ毎に分割する際、テンプレート』(お母さん) 
について...

 お分かりになる方がいらっしゃいましたら教えてください。
 上記のmook様が書かれたコードについてです。「元データの分割判定を行う列」の「分類列 = "C"」に該当する部分のC列のデータですが、直接入力したデータであれば上手くいきます。
 ところが、別のファイルからコピーしたデータを値だけ貼り付けて使用すると「実行時エラー アプリケーション定義またはオブジェクト定義のエラーです。」というエラーが出てしまいます。デバッグでは「最終行 = .Cells(Rows.Count, 分類列).End(xlUp).Row」が黄色になっています。
 別ファイルからコピーしたデータというのは、C列に数式データが入っており、それを「値だけを貼り付け」したものです。解決方法をお教えください。

< 使用 Excel:Excel2016、使用 OS:Windows10 >


 つかぬ事をお聞きしますが、
 関係するエクセルファイルの拡張子が混在していませんか?(.xls,.xlsx など新旧混在していないか、と言うことです)

(半平太) 2016/09/29(木) 17:08


半平太様、目を通していただいてありがとうございます。
今確認しましたら、コピーしたデータは同ファイル内(Microsoft Excel Macro-Enabled Worksheet (.xlsm))の別シートで作ったものでした、申し訳ございません。新旧混在していないと思うのですが・・どうでしょうか。
(ななし) 2016/09/29(木) 17:25

 そうですか。。。

 念のため、上記トラブった時、プログラムを止め、
 後記プログラム(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)
 '//--------------------------------------------------------
 '// オプション
 '//--------------------------------------------------------
 '//-------------------------
 '// 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         '---  各シートのデータ開始行(ヘッダ行+1)
 '//--------------------------------------------------------

元シートのデータはA〜I列まで3000行くらいありまして、

A列 ナンバー(1〜約3000)の数字。数式で導き出した数字をコピペして値だけ貼り付けている。

B列 東京・大阪などの数種類の文字列(分類列)
C〜I列 数字や文字列など。ところどころ空欄もあり、データ判定列"E"は空欄のないすべて文字列で埋まっている列を指定した。

以上です。

(ななし) 2016/09/30(金) 14:56


訂正です。「ところどころ空欄もあり、」と表記してしまいましたが誤りで、とりあえずA〜I列、指定の約3000行までは空欄はありませんでした。たびたび申し訳ございません。
(ななし) 2016/09/30(金) 15:14

 回答でなくて申し訳ない。
 編集ボタンがないのになぜ質問・回答が消されているのか。
 そのうち管理人さんが復元してくれると思うけど不思議だな。
(bi) 2016/09/30(金) 15:20

 こちらでは、現象が再現しないです。

 再現手順を示していただかないと、私はこれ以上は対応できません。 

 申し訳ないです。m(__)m

(半平太) 2016/09/30(金) 16:12


過去ログが消えたのは、ななしさんのせいでは無いように思います。最近、削除機能を無くしているので、削除しようとしてもできませんから、掲示板側の問題でしょう。
(バグなのか、それとも、削除ボタンは消したけれどロジックは残っていて、誰かがこれを直接叩いて消した、とか?)
(???) 2016/09/30(金) 16:14

半平太様、今1からファイルを作り直してマクロを入れなおしたら上手くいきました・・!
もしかしたら、他のコードとmookさんのコードを同じモジュールに入れてたせい?かもしれません・・!お恥ずかしいです。
大変お手数おかけして申し訳ありませんでした。どうもありがとうございました・・!!

リンク先が消えているのはぜひまた復元されるといいなと思います…!他で検索してもでてこないありがたいコードでしたので…。そしてまたこのコードについてお伺いするかもしれませんがよろしくお願いいたします!

(ななし) 2016/09/30(金) 17:29


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.