Results of 1 - 1 of about 48816 for A�����������������������... (0.010 sec.)
- [[20150930112510]]
- #score: 1420
- @digest: 3416f194279e8c5064782df0cc13cce3
- @id: 68990
- @mdate: 2015-10-07T10:42:10Z
- @size: 78386
- @type: text/plain
- #keywords: 枚| (242342), 箱| (132073), 袋| (115439), scoperange (112750), 果シ (92265), adrremain (79719), lila (78843), 大項 (40682), 品番 (29021), （li (26362), クッ (19510), タシ (15493), 品目 (12838), 名| (12045), 2015 (10505), グレ (9544), ッキ (8368), range (7420), （β (6402), value (5975), 結果 (5834), 品名 (5802), レー (5693), 項目 (5247), デー (5227), 処理 (4944), replace (4932), ・・ (4646), シー (4636), ータ (4621), アウ (4459), ウト (4308)
- 『他のブックからVBAでデータ抽出する方法（2）
』（Lila） ※前トピ [[20150914090339]] 前トピが長くなったので、作成しました。 **データの名称** クッキー 大項目 プレーン 中項目 5枚 小項目 箱 形状 **レイアウト** 【実データシートブックレイアウト】 |[D]|[E] |[F] |[G]|[H]|[I]|[J]|[K]|[L]|[M]|[N]|[O] |[P] |[Q] |[R] |[S]|[T]|[U]|[V]|[W]|[X]|[Y]|[Z]|[AA]|[AB]|[AC]|[AD]|[AE]|[AF]|[AG] [3] |No.|レベル| 品番 |版数|品名 | 数量 |区分|ユニット [4] | | | | | | クッキー | Bクッキー | | [5] | | | | | | プレーン | チョコ |プレーン| チョコ | | [6] | | | | | | 5枚 | 10枚 | 5枚 | 10枚 |5枚|10枚|5枚 | 5枚| 5枚| 5枚| | [7] | | | | | |袋 |箱 |袋 |箱 |袋 |箱 |袋 |箱 |袋 |箱 |袋 |袋 |袋 |袋 | | [8] | | | | | | | | | | | | | | | | | | | | | [9] | | | 0| 1| 2| 3| 4| 5| 6| 7| 8| | | | | | | | | | | | | | | | | | | [10]| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | [11]| | 0|A021701| | | | | | | | |A021701| 00|ABCDSERGH | 1| | | | | | | | | | | | | | 20|梱包 [12]| | 0|A021702| | | | | | | | |A021702| 00|ASFREGTRYJU | | 1| | | | | | | | | | | | | 20|梱包 [13]| | 0|A021711| | | | | | | | |A021711| 00|Jvserfrehytr | | | 1| | | | | | | | | | | | 20|梱包 [14]| | 0|A021712| | | | | | | | |A021712| 00|SFREYGTJUKI< | | | | 1| | | | | | | | | | | 20|梱包 ・ ・ ・ [1346] 【大項目のみのデータシートブックレイアウト】 |[D]|[E] |[F] |[G]|[H]|[I]|[J]|[K]|[L]|[M]|[N]|[O]|[P] |[Q] |[R] |[S] |[T] |[U] [3] |No |レベル| 品番 |版数|品名|数量 | |区分|ユニット [4] | | | | | |せんべい|もち| | [5] | | | | | | | | | [6] | | | | | | | | | [7] | | | | | | | | | [8] | | | | | | | | | [9] | | | 0| 1| 2| 3| 4| 5| 6| 7| 8| | | | | | | [10]| | | | | | | | | | | | | | | | | | [11]| 1| 0|M009993 | | | | | | | | | | | | 1| | 20|梱包 [12]| 2| 0|M011095 | | | | | | | | | | | | | 1| 20|梱包 [13]| 3| 0|M513069 | | | | | | | | | | | | 1| | 20|梱包 [14]| 4| 0|D3M-01K1-3| | | | | | | | | | | | 1| | | [15]| 5| 0|M513073 | | | | | | | | | | | | | 1| | [16]| 6| 0|M602669 | | | | | | | | | | | | | 2| | [17]| 7| 0|M513074 | | | | | | | | | | | | 3| | | [18]| 8| 0|M513075 | | | | | | | | | | | | | 5| | 【結果シートブックレイアウト】 |[A] |[B] |[C] |[D] |[E]|[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M]|[N] |[O]|[P] |[Q]|[R] |[S]| [1] |品番 |品目|品名|英語品名| |せんべい|もち| Cクッキー | クッキー | [2] | | | | | | | | 加糖 | 無糖 | プレーン | チョコ | [3] | | | | | | | |5枚 |10枚 |5枚 |10枚|5枚 | |10枚| |5枚 | |10枚| | [4] | | | | | | | |ケース |ふくろ|小箱|束 |箱 |袋 |箱 |袋 |箱 |袋 |箱 |袋 | [5] |A021701 |a |a |a |a |a |a |a |a |a |a |a |a |a |a | | 1| | | [6] |A021702 |a |a |a |a |a |a |a |a |a |a |a |a |a |a | 1| | | | [7] |A021711 |a |a |a |a |a |a |a |a |a |a |a |a |a |a | | | 1| 1| [8] |A021712 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a | [9] |A021751 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a | [10]|A021752 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a | [11]|A021761 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a | [12]|A021762 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a | [13]|M009993 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a | [14]|M011095 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a | [15]|M513069 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a | [16]|D3M-01K1-3|a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a | [17]|M513073 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a | [18]|M602669 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a | [19]|M513074 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a | ・ ・ ・ [15794] ＜ 使用 Excel:Excel2013、使用 OS:Windows7 ＞ ---- ●まず 最後の ( ) 内というと、 Set r1 = shF.Cells(comRow, comCol).Resize(nRows) '品番領域] これは nRows つまり、品番の領域の行数（品番の数） です。 これが 3 ということは 3行ですので （（β） 2015/09/24(木) 09:27 のレイアウトなら正しいですね。 ただ、（Lila） 2015/09/29(火) 15:45 のレイアウトでの確認で、これが 25 になったんですか? アップされた例では 11行目から14行目までの 4 になるはずなんですが? それと、 r2 のほうは、最後の ( ) 内は 4,nCols の 2つの値です。 nCols にマウスを当てれば 項目の列数になります。 （Lila） 2015/09/29(火) 15:45 のレイアウトでは、R列〜AE列までの 14 で、これは正解ですね。 ●以下のパターンで、転記される、されない、あるいは される場合もあり、されない場合のある。 この3つにわけて整理していただけませんか。 1.大項目のみ、あとは空白の手入力によるテストデータ 2.大項目のみ、あとは空白だけど、実物のデータ 3.大項目〜形状まで、すべてある手入力によるテストデータ 4.大項目〜形状まで、すべてあるけど、実物のデータ ●品番項目、セル結合を解いたり、結合したまま確認もしましたが、スペースは入っていないです。 スペースの有無は、数式バー等で目視できますよね。スペースではなく制御文字の場合は、目視ではわからないので その状態を作り出すコードをアップしましたが、データシートの"品番" と入ったセルに対して =LEN(そのセル) で、ちゃんと 2 がでるということですか? ★あと、このトピも、長くなって、スクロールも大変になってきました。 このトピを 『他のブックからVBAでデータ抽出する方法』（Lila） こんなように参照した形で No.2 トピを立ち上げてもらったほうがよさそうですね。 （β） 2015/09/30(水) 11:06 ＞ただ、（Lila） 2015/09/29(火) 15:45 のレイアウトでの確認で、これが 25 になったんですか? ＞ アップされた例では 11行目から14行目までの 4 になるはずなんですが? アップしたのは4行までですが、実際のデータは1346行までありますので、やはり「25」はおかしいですね・・・ ＞ ●以下のパターンで、転記される、されない、あるいは される場合もあり、されない場合のある。 ＞この3つにわけて整理していただけませんか。 【転記されない】 ＞ 1.大項目のみ、あとは空白の手入力によるテストデータ ＞ 2.大項目のみ、あとは空白だけど、実物のデータ ＞ 4.大項目〜形状まで、すべてあるけど、実物のデータ 【転記される】 ＞ 3.大項目〜形状まで、すべてある手入力によるテストデータ 【転記される場合もあり、されない場合もある】 今のところ再現なし ＞スペースの有無は、数式バー等で目視できますよね。スペースではなく制御文字の場合は、目視ではわからないのでその状態を作り出すコードをアップしましたが、データシートの"品番" と入ったセルに対して =LEN(そのセル) で、ちゃんと 2 がでるということですか? そうです。 ちゃんと2が出ました。 ＞★あと、このトピも、長くなって、スクロールも大変になってきました。 このトピを 『他のブックからVBAでデータ抽出する方法』（Lila） こんなように参照した形で No.2 トピを立ち上げてもらったほうがよさそうですね。 了解しました! では、必要そうなレイアウトと今の所の情報を書き込んで、トピック立ち上げますね! （Lila） 2015/09/30(水) 11:24 前トピの一番最新レスも貼っておきます。 （Lila） 2015/09/30(水) 11:46 ---- わかったような・・・ごめんなさいというか・・・ 手作業のものは大項目のみであろうと、項目がすべて指定されている状態であろうとすべて反映されていると そう思いこんでいましたので、実物のシートのセルの項目が変になっているに決まっていると、そう決めつけていました。 今回、虚心坦懐（?）にコードを1行ずつおいかてたら・・・なんだこれは! というところ発見。 もう少し、精査して、修正して前進があればアップします。 ちょっと、期待して（?）待っててください。 （β） 2015/09/30(水) 17:08 ---- ながらく、ご迷惑をおかけしました。 コメントしたように、データが悪いと決めつけてたことと、手入力のデータなら大項目のみでもマッチすると 勘違いしていたため、コードのチェックに身が入っていませんでした。 やはり、コードは、4項目すべてが入力されているときのみをカバーしていて、かつ、その列数把握にもバグがありました。 結果シート処理のところに '結果シート処理 Set shT = ThisWorkbook.Sheets("Sheet1") '★シート名変更 Set dicH = CreateObject("Scripting.Dictionary") '結果シート列タイトル辞書 mxCol = shT.Cells(4, Columns.Count).End(xlToLeft).Column '結果シートの1行目のデータ最終列を求める mxCol = mxCol + shT.Cells(4, mxCol).MergeArea.Columns.Count - 1 'そのセルの結合セルの列数を加味して、表の最終列を求める mxRow = shT.Range("A" & Rows.Count).End(xlUp).Row '結果シートの品番最終行 nRows = mxRow - 4 '結果シートの品番数 こんなコードがあると思います。これを '結果シート処理 Set shT = ThisWorkbook.Sheets("Sheet1") '★シート名変更 Set dicH = CreateObject("Scripting.Dictionary") '結果シート列タイトル辞書 mxCol = shT.Cells(1, Columns.Count).End(xlToLeft).Column '結果シートの1行目のデータ最終列を求める mxCol = mxCol + shT.Cells(1, mxCol).MergeArea.Columns.Count - 1 'そのセルの結合セルの列数を加味して、表の最終列を求める mxRow = shT.Range("A" & Rows.Count).End(xlUp).Row '結果シートの品番最終行 nRows = mxRow - 4 '結果シートの品番数 nCols = mxCol - Columns("F").Column + 1 '表の列数 こうかえて試していただけますか。 （β） 2015/09/30(水) 18:38 ---- βさんおはようございます。 いつもありがとうございます。 結果シート処理の方書き直しました。 けれど、その前の品番開始の箇所が25行までしか取り込んでくれていないので、やはり反映されません・・・ 結果シートブックの方に無い品番もデータシートブックの方には含まれて居ますので、恐らくその25行のところに合致するデータが無いのだと思われます。 ＞ mxRow = shF.Cells(Rows.Count, comCol).End(xlUp).Row 'データシートの品番列最終行番号 ＞ '品番開始行 ＞ comRow = shF.Cells(mxRow, comCol).End(xlUp).Row ＞ '=================================='データシートレイアウト規定 終了 ＞ nRows = mxRow - comRow + 1 この処理の所で、このときに格納されている値が 「mxRow」=1346 「Rows.Count」 =1048576 「xlUp」 =-4162 「comRow」 =1322 「comCol」 =6 「nRows」 =25 となっています。 ＞「xlUp」 =-4162 というのは、何の値になるのでしょうか・・・? （Lila） 2015/10/01(木) 08:46 ---- なかなか、スパっとはいきませんねぇ。 でも、ここの行数の問題をクリアできれば前進するかもですね。 まず Rows.Count は、その時にアクティブなエクセルシートの物理的な最大行数で、xl2007以降は 1048756 です。 で、xlUp は、エクセルの組み込み定数で、値は -4162 ですけど、この値は気にしないでください。 メソッドの引数として与える条件で、 基準セル.End(xlup) と書くと、基準セルから上に眺めて、最初に値があるセルということです。 ちなみに 基準セル.End(xlDown) と書くと、基準セルから下に眺めて、最後に値があるセルということになります。 ともに、データ最終行を求めるときの1つの定番コードとして使います。 この時点で mxRow これは品番の最終行番号です。ここが 1356 ということは、1356行までが品番だと、そう認識しているわけです。 問題は comRow。これは品番の開始行なんですが、ここが 1322 ですか?? この comRow は、 '品番開始行 comRow = shF.Cells(mxRow, comCol).End(xlUp).Row ここで求めています。 ↑で説明したように、基準セル（品番の最終セル）から上に眺めて、空白セルが登場する1つ前のセル。 ここを開始セルだと判断しているロジックです。 いいかえると、マクロは、品番の中に空白で途切れるところがないと想定しています。 たとえば 1321行目の品番列のセルが空白で、でも、品番は、1320行より上に（おそらく11行目まで）たくさんあっても、品番は 1322行から1356行までの範囲だと、そう認識します。 これが原因ですかね? 実物のデータで、品番の中に空白セルが、どうしても登場するということであれば、さて、どういう判定ロジックにするか。 目で見れば、あきらかなんですよ。11行目のM009993が品番の最初なんだと。 でも、これをどう汎用的なというか、確かなロジックとするか、悩みどころです。 以前に、この品番開始セルを、どう判断するか、という話をしたときに "品番" という文字があらわれる列のデータ最終セル(1356行目)から上にみて、空白の手前。 つまり、 M009993 の上、レベル 0 と入っているところとの間には、必ず空白セルがあるので それを頼りに判断しましょうということにしましたね。 そのロジックが働いて 1322行が先頭になってしまっていると思われますね。 ★品番の途中に空白があるという想像でのコメントですが。 そのあたり、いかがですか? （β） 2015/10/01(木) 09:30 ---- なるほど・・・そこに問題があったのですね。 ＞★品番の途中に空白があるという想像でのコメントですが。 ＞そのあたり、いかがですか? そうですね、途中でここから下はこの商品のこの部分に使ってる部品的な説明のある行がいくつかあり、使用していない（グレーアウトしていた）行は削除していたのですが、1箇所残ってしまっていました。 その行を削除したら、無事「11」が格納されました! しかし、結果シートには記載されず・・・orz 一旦、結果シートに記載されている品番だけの表にして、もう一度試してみます;; （Lila） 2015/10/01(木) 09:46 ---- データシートの品番を、結果シートに載っているものだけにしたシートを作成し、テストしてみました。 ですが、やはり結果シートに記載されず・・・;; テストレイアウトでは転記されたのに、一体・・・ 大項目のみの方のテストレイアウトの方で試してみましたが、こちらもやはり転記されず・・・でした・・・。 （Lila） 2015/10/01(木) 14:20 ---- う〜ん・・・ まいりましたねぇ・・・ でも、チャンスかもしれません。 今、反映しなかったデータシートが目の前にありますよね。 それにたいして、すべてといいたいところなんですが、1つか2つの品番、これは反映するはずなのに 反映しない! という品番を、手打ちで上書き。 A123456 と入っていれば、A123456 と入力しなおす。 で、その品番に対する数値が入っている大項目〜形状のセルも同様に入力。（クッキーならクッキー。空白なら Deleteキー） さらに、データ取り込み の End Sub の直前に MsgBox "r1: " & r1.Address(external:=True) & vbLf & "r2: " & r2.Address(external:=True) & vbLf & "r3: " & r3.Address(external:=True) & vbLf & "nCols: " & nCols & vbLf & "nRows: " & nRows を貼り付けて、実行して結果がどうなるか、メッセージの内容も含めて教えてください。 (なお、メッセージで表示される各領域や商品の行数や項目の桁数が、データシートの実物と同じかどうかも確認してください。） （β） 2015/10/01(木) 16:15 ---- ↑ >>データ取り込み の End Sub の直前に ではなく、'結果シート処理 というコメントがある行の直前にしてください。 （β） 2015/10/01(木) 16:30 ---- βさん、いつもありがとうございます・・・! 長々とお付き合い頂いて、本当に助かります;; 指定のコードを貼り付けて、実行してみました。 r1:[てすと1.xlsx]Sheet1!$F$11:$F$445 r2:[てすと1.xlsx]Sheet1!$R$4:$AE$7 r3:[てすと1.xlsx]Sheet1!$R$11:$AE$445 nCols:14 nRows:435 となりました。 それぞれ、範囲は問題が無いような気がしますね・・・? （Lila） 2015/10/01(木) 16:46 ---- 範囲はOKだったとして（それはそれで、ほっとしてますが） ・実行しても転記されない ・お願いしたセルの打ち直しを行う ・実行する この結果はどうでしたか? （β） 2015/10/01(木) 17:18 ---- ＞ ・実行しても転記されない やはり、転記はしてくれていないです・・・ ＞ ・お願いしたセルの打ち直しを行う 上から3つの品番、項目全てを打ち直ししました。 （Lila） 2015/10/01(木) 17:20 ---- そうなると、問題はデータシート側でなく、現にバグがありましたけど、結果シート側かもしれませんね。 もう1つMsgBoxを追加して確かめてもらえますか。 データ取り込み の End Sub の直前に MsgBox "結果シート" & vbLf & "品番: " & Range("A5").Resize(nRows).Address & vbLf & "項目: " & Range("F1").Resize(4, nCols).Address & vbLf & "データ: " & Range("F5").Resize(nRows, nCols).Address これも正しい値であれば、う〜ん・・・迷宮入りかも・・・・ （β） 2015/10/01(木) 18:37 ---- 追加で。 （β） 2015/09/30(水) 18:38 の修正を加えた後 1.大項目のみ、あとは空白の手入力によるテストデータ 2.大項目のみ、あとは空白だけど、実物のデータ 3.大項目〜形状まで、すべてある手入力によるテストデータ 4.大項目〜形状まで、すべてあるけど、実物のデータ これらの、それぞれの結果は変わりましたか? 全く変わらず、うまくいくのは 3.だけですか? （β） 2015/10/01(木) 18:45 ---- こちらでいろいろパターンを変えているうちに、ちょっとおかしな現象発見。 もしかしたら光明がさすかも?? ただいまデバッグ中。 おかしな現象は再現していますので、いずれバグつぶしはできると思いますが ちょっと時間ください。 10/1 20:06 （β） 2015/10/01(木) 19:10 ---- 残念なお知らせです。 こちらで再現したので、あとは、バグを発見するだけだと勢い込んだんですが、 こちらで、データをいろいろ切り貼りしたりしているうちに、空白セルのところに、スペースがはいったり ゴミがはいったり、そういうことで、そこをクリアして補正したら、正常に取り込みができました。 コードとしては（コメント含めて）不適切なところもあるのですが、実行には影響のない部分でした。 う〜ん・・・悩みますねぇ。 （β） 2015/10/01(木) 20:35 ---- 障害発生が勘違いだったので、ちょっとがっくりきているのですが、現在のコードで、以下のシートで処理した結果を アップしておきます。（2つのデータブックを選んで処理） ●処理前の結果シート |[A] |[B] |[C] |[D] |[E]|[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M]|[N] |[O]|[P] |[Q]|[R] |[S] [1] |品番 |品目|品名|英語品名| |もち|せんべい| Cクッキー | | | |クッキー| | | | | | | [2] | | | | | | | | 加糖 | | 無糖 | |プレーン| | | |チョコ| | | [3] | | | | | | | |5枚 |10枚 |5枚 |10枚|5枚 | |10枚| |5枚 | |10枚| [4] | | | | | | | |ケース |ふくろ|小箱 |束 |箱 |袋 |箱 |袋 |箱 |袋 |箱 |袋 [5] |A002345 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [6] |V024852 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [7] |BFD1548 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [8] |A021701 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [9] |A021702 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [10]|A021711 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [11]|A021712 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [12]|A021751 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [13]|A021752 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [14]|A021761 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [15]|A021762 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [16]|M009993 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [17]|M011095 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [18]|M513069 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [19]|M513074 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a ●対象データシート（1） |[A]|[B] |[C] |[D]|[E]|[F]|[G]|[H]|[I]|[J]|[K]|[L] |[M]|[N] |[O]|[P]|[Q] |[R] |[S] |[T] |[U] |[V]|[W] |[X] [1] | | | | | | | | | | | | | | | | | | | | | | | | [2] | | | | | | | | | | | | | | | | | | | | | | | | [3] | | | | | | | | | | | | | | | | | | | | | | | | [4] | | | | | | | | | | | | | | | | | | | | | | | | [5] | | | | | | | | | | | | | | | | | | | | | | | | [6] | | | | | | | | | | | | | | | | | | | | | | | | [7] |No |レベル|品番 | | | | | | | | | | | | | |数量 | | | | | | | [8] | | | | | | | | | | | | | | | | | Cクッキー | | | |クッキー| | | [9] | | | | | | | | | | | | | | | | | 加糖 | | 無糖 | |チョコ | | | [10]| | | | | | | | | | | | | | | | |5枚 |10枚 |5枚 |10枚|5枚 | |10枚| [11]| | | | | | | | | | | | | | | | |ケース |ふくろ|小箱 |束 |箱 |袋 |箱 |袋 [12]| | | | | | | | | | | | | |品名| | | | | | | | | | [13]| | | 0| 1| 2| 3| 4| 5| 6| 7| 8| 0| | | | | | | | | | | | [14]| | | | | | | | | | | | | | | | | | | | | | | 9| [15]| 1| 0|A021701| | | | | | | | |A021701 | | | | | | | | | | | | 8 [16]| 2| 0|A021702| | | | | | | | |A021702 | | | | | | | | | | | 7| [17]| 3| 0|A021711| | | | | | | | |A021711 | | | | | 1| | | | 5| | | ●対象データシート（2） |[A]|[B]|[C]|[D]|[E] |[F] |[G]|[H]|[I]|[J]|[K]|[L]|[M]|[N]|[O] |[P]|[Q] |[R] |[S] |[T] [1] | | | | | | | | | | | | | | | | | | | | [2] | | | | | | | | | | | | | | | | | | | | [3] | | | |No |レベル|品番 | | | | | | | | | | | |数量| | [4] | | | | | | | | | | | | | | | | | |もち| | [5] | | | | | | | | | | | | | | | | | | |区分|ユニット [6] | | | | | | | | | | | | | | | | | | | | [7] | | | | | | | | | | | | | | | | | | | | [8] | | | | | | | | | | | | | | | | |品名| | | [9] | | | | | | 0| 1| 2| 3| 4| 5| 6| 7| 8| | | | | | [10]| | | | | | | | | | | | | | | | | | | | [11]| | | | 1| 0|A002345| | | | | | | | |A002345| | | 1| | [12]| | | | 2| 0|V024852| | | | | | | | |V024852| | | 2| | [13]| | | | 3| 0|BFD1548| | | | | | | | |BFD1548| | | 3| | ●処理後の結果シート |[A] |[B] |[C] |[D] |[E]|[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M]|[N] |[O]|[P] |[Q]|[R] |[S] [1] |品番 |品目|品名|英語品名| |もち|せんべい| Cクッキー | | | |クッキー| | | | | | | [2] | | | | | | | | 加糖 | | 無糖 | |プレーン| | | |チョコ| | | [3] | | | | | | | |5枚 |10枚 |5枚 |10枚|5枚 | |10枚| |5枚 | |10枚| [4] | | | | | | | |ケース |ふくろ|小箱 |束 |箱 |袋 |箱 |袋 |箱 |袋 |箱 |袋 [5] |A002345 |a |a |a |a | 1|a |a |a |a |a |a |a |a |a |a |a |a |a [6] |V024852 |a |a |a |a | 2|a |a |a |a |a |a |a |a |a |a |a |a |a [7] |BFD1548 |a |a |a |a | 3|a |a |a |a |a |a |a |a |a |a |a |a |a [8] |A021701 |a |a |a |a |a |a | | | | |a |a |a |a | | | | 8 [9] |A021702 |a |a |a |a |a |a | | | | |a |a |a |a | | | 7| [10]|A021711 |a |a |a |a |a |a | 1| | | |a |a |a |a | 5| | | [11]|A021712 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [12]|A021751 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [13]|A021752 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [14]|A021761 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [15]|A021762 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [16]|M009993 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [17]|M011095 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [18]|M513069 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a [19]|M513074 |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a |a （β） 2015/10/01(木) 21:12 ---- 絶対とは言えませんが、こちらで試行する限りデータの整合性が取れていれば、確実に反映します。 こうなれば（?）だめもとで、関連のシート（比較シートやデータシート）をアクティブシートにした上で 以下のコードを走らせて無理やり（?）データ補正をしたあと、試してみるとか・・・ Sub 補正() Dim c As Range For Each c In ActiveSheet.UsedRange c.Value = WorksheetFunction.Clean(Replace(Replace(c, " ", ""), " ", "")) Next End Sub （β） 2015/10/01(木) 21:21 ---- それと、（β） 2015/10/01(木) 20:35 で、コメントとコードに不適切なものがあるとレスしました。 For Each r In shT.Range("A5").Resize(nRows) 'データシートの品番取り出し とありますが、コメント間違い。 For Each r In shT.Range("A5").Resize(nRows) '結果シートの品番取り出し です。 それと、コードの間違い（どのシートがアクティブになっていようと、処理結果が異なることはないのですが、コードとしては不適切） 最後のほうに For Each c In Range("F5").Offset(y - 1).Resize(, nCols) こんなコードがありますが、意図としては For Each c In shT.Range("F5").Offset(y - 1).Resize(, nCols) です。（実行結果に影響はないですが） （β） 2015/10/01(木) 22:18 ---- おはようございます。 テストデータは両方新規で手打ち作成だったので（コードはコピーしましたが）もしかしたら、実データの方（データ、結果ブック含め）に問題があるのかなぁとは思いますが・・・ 結果シートの方ですが、オートシェイプで作成したボタン（品番〜英品名読み込みマクロと列追加マクロ登録済の2つのボタン）が置いてあるのですが、結果が反映されないことに、関係ありますか? とりあえず、昨日βさんがコメントして下さった部分の検証を行ってみます! （Lila） 2015/10/02(金) 08:30 ---- まず、こちらの結果です。 ＞（β） 2015/10/01(木) 18:37 結果シート 品番:$A$5 項目:$F$1:$AC$5 データ:$F$5:$AC$5 で、やはりこちらの範囲も問題が無いように思います。 ちなみに、昨日の夕方使用した「品番を上から3つ、項目全部を手打ちで入力しなおし、空白部はDeleteを施した"結果シート"に品番のあるものだけ抽出した"データシート"」を使用しています。 （Lila） 2015/10/02(金) 08:47 ---- ＞ 1.大項目のみ、あとは空白の手入力によるテストデータ F11:F18 R4:S7 R11:S18 データの方の範囲は合っていました。 品番:A5:A20 項目:F1:AE20 データ:F5:AE20 が、何故か結果の方がおかしかったです。 もちろん、転記はされず。 ＞ 2.大項目のみ、あとは空白だけど、実物のデータ 範囲は正常でしたが、やはり転記されず。 ＞ 3.大項目〜形状まで、すべてある手入力によるテストデータ F11:F13 R4:AE7 R11:AE13 A5:A20 F1:F4 F5:AE20 範囲も正常で、転記も完璧。（取り消し線項目は転記されず正常） ＞ 4.大項目〜形状まで、すべてあるけど、実物のデータ F11:F1345 R4:AE7 R11:AE1345 品番が、何故か範囲でなかったです。 A5 F1:AC4 F5:AC5 で、やはり3だけがうまく行っている状態です。 （Lila） 2015/10/02(金) 09:36 ---- ＞（β） 2015/10/01(木) 21:21 こちらの処理は、結果シート、データシート双方にこの補正マクロを実行するという意味ですか? それとも、結果シートにマクロを書き込み、双方のブックを開いた状態にして実行してみるという意味でしょうか? （Lila） 2015/10/02(金) 09:43 ---- >>オートシェイプで作成したボタン（品番〜英品名読み込みマクロと列追加マクロ登録済の2つのボタン）が置いてあるのですが、 >>結果が反映されないことに、関係ありますか? それは関係ありません。シェープがあろうが、その下のセルも含めて、セルの値がなくなるわけではないので。 登録されているマクロがちょっと気にはなります。こちらで、データシートと結果シート、マッチするものしないものを 組み合わせようと、挿入したり削除したり、結合を外したり結合したり、そうしているうちに、たとえば品番の末尾に 空白がついてしまったりゴミ（制御文字）が付加されたり。これは作業上の操作が悪かったのですが。 なので、強引に （β） 2015/10/01(木) 21:21 でアップしたコードで補正をかけて実行してすべてOKになりました。 もしかしたら、ボタンに登録されているマクロが悪さを?? >>品番:A5:A20 >>項目:F1:AE20 >>データ:F5:AE20 >>が、何故か結果の方がおかしかったです。 本来は、どうあるべきだったのでしょう。 また、このおかしな領域、実際のシートの上で見た時に、何か思いつくことはないでしょうか? なぜ、マクロがこの、間違えた領域を採用してしまったのか。 >>品番が、何故か範囲でなかったです。 >>A5 >>F1:AC4 >>F5:AC5 同じく、正しくはどんな範囲だったんでしょうか。 少なくとも、このメッセージだけを見ると、品番が1行だけということになっているんですよね。 >>こちらの処理は、結果シート、データシート双方にこの補正マクロを実行するという意味ですか? 現在出ている障害の結果によっては、このマクロを、現在のコードに（もう少し効率をアップした形にして） 埋め込むということも考えられますが、今は、まず、新規ブックで、単独に、このマクロだけを書いておいて 結果ブックを開いて、結果シートをアクティブにして、このマクロを実行して結果ブックを保存。 またデータブックを開いてデータシートをアクティブにして、このマクロを実行して、データブックを保存。 こうして、強制補正されたブックを使った処理で、どうなるかを試していただきたいということです。 ★ただ、データは、あまり関係ないかもしれませんね。そちらの報告では、そもそもが範囲の認識が マクロと実物で異なるわけですので。 気になっているのは、何度かコメントしておられる【グレーアウト】 2003時代の記憶で、たとえばある列以降をすべて非常にすると、グレーになったと思いますが 2010や2013では、グレーではなくホワイト。 この【グレーアウト】、各担当さんがセットしていると思いますけど、その担当さんに、この【正体】を聞いてもらえませんか? （β） 2015/10/02(金) 14:01 ---- ＞ >>品番:A5:A20 ＞ >>項目:F1:AE20 ＞ >>データ:F5:AE20 ＞ >>が、何故か結果の方がおかしかったです。 ＞ 本来は、どうあるべきだったのでしょう。 ＞ また、このおかしな領域、実際のシートの上で見た時に、何か思いつくことはないでしょうか? ＞ なぜ、マクロがこの、間違えた領域を採用してしまったのか。 テスト用の結果シートなので、3と同じく ＞F1:F4 の項目範囲にならないのは何故なのか・・・という事です。 実際のシート上で見たとき・・・といわれても、3の方ではしっかり範囲選択されているのに、どうしてだろう・・・と。 強いて言えば、中項目〜形状が空白・・・という事ですかね・・・?（でも同じ結果シートを使用していて3では取得しているので、関係なさそうですよね・・・） ＞ >>品番が、何故か範囲でなかったです。 ＞ >>A5 ＞ >>F1:AC4 ＞ >>F5:AC5 ＞ 同じく、正しくはどんな範囲だったんでしょうか。 ＞ 少なくとも、このメッセージだけを見ると、品番が1行だけということになっているんですよね。 結果シートの品番の範囲は「A5:A15793」となるはずなのです。 ですが、気になる点があり、セルをひとつづつ見ていくと、確かにそのセルに文字が入っていることが確認できる（エクセルリボン下のセルの内容が見える所にもセルにも同じことが書かれている）のですが、Ctrl+PgDnなどの操作を品番列で実行すると、本来なら文字ある最終列に行くと思うのですが、何故か最後尾（A1048576）のセルへ行ってしまい、今度はCtrl+PgUpをすると、「A5」セルへ行ってしまいます。 隣の「品目」や「品名」列は、正常に作動し文字のある最終セル「B15794」ないし「C15794」へ移動してくれます。 ＞ >>こちらの処理は、結果シート、データシート双方にこの補正マクロを実行するという意味ですか? ＞ 現在出ている障害の結果によっては、このマクロを、現在のコードに（もう少し効率をアップした形にして） ＞ 埋め込むということも考えられますが、今は、まず、新規ブックで、単独に、このマクロだけを書いておいて ＞ 結果ブックを開いて、結果シートをアクティブにして、このマクロを実行して結果ブックを保存。 ＞ またデータブックを開いてデータシートをアクティブにして、このマクロを実行して、データブックを保存。 ＞ こうして、強制補正されたブックを使った処理で、どうなるかを試していただきたいということです。 了解です。 そのように検証してみます。 現在、本日中に終わらせなければいけない作業を行っているので、その後出来れば本日中に行いたいと思います。 が、もしも間に合わなかった場合は、月曜になってしまうかもしれません。 お付き合いいただいているのに申しわけありません; ＞ ★ただ、データは、あまり関係ないかもしれませんね。そちらの報告では、そもそもが範囲の認識が ＞ マクロと実物で異なるわけですので。 ＞ 気になっているのは、何度かコメントしておられる【グレーアウト】 ＞ 2003時代の記憶で、たとえばある列以降をすべて非常にすると、グレーになったと思いますが ＞ 2010や2013では、グレーではなくホワイト。 ＞ この【グレーアウト】、各担当さんがセットしていると思いますけど、その担当さんに、この【正体】を聞いてもらえませんか? 非常、というのがどんな操作なのかちょっとわからないですが、グレーアウトになっているのは恐らく「セルの塗りつぶし」でグレーを置いているのだと思われます。（同じくグレーのみではなく、緑や黄色にされている箇所もあり、セルの色を変えられるので） その「非常」という操作をしていてもセルの色が変えられる場合は、その操作をしている可能性もありますが・・・。 （Lila） 2015/10/02(金) 14:47 ---- ＞もしかしたら、ボタンに登録されているマクロが悪さを?? 一応、登録しているマクロを貼っておきます。 「品番〜英品名取得マクロ」 Sub 品番取得() Dim fn As String Dim wb As Workbook fn = ThisWorkbook.Path & "¥リスト.xlsx" Application.ScreenUpdating = False Set wb = Workbooks.Open(fn) With wb.Worksheets("リスト") .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Copy End With ThisWorkbook.Sheets("Sheet1").Range("A5").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False wb.Close False Application.ScreenUpdating = True 'Sub 品目、品名、品番更新() Dim FaN As String Dim WBo As Workbook FaN = ThisWorkbook.Path & "¥リスト.xlsx" Application.ScreenUpdating = False Set WBo = Workbooks.Open(FaN) With WBo.Worksheets("リスト") .Range("A2:C" & .Range("A" & Rows.Count).End(xlUp).Row).Copy End With ThisWorkbook.Sheets("Sheet1").Range("B5").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False WBo.Close False Application.ScreenUpdating = True 'Sub 文字削除() Dim re, a1 As Range Set re = CreateObject("VBScript.RegExp") re.Pattern = "MP-" Range("A:A").Select For Each a1 In Selection a1.Value = re.Replace(a1.Value, "") Next Set re = Nothing End Sub 「列追加マクロ」 Sub 列追加() Dim num As Long '変数を宣言 Dim i As Long num = InputBox("追加する列数を入力してください。") 'ダイアログボックス呼び出し For i = 1 To num 'num列追加 Columns("F:F").Insert shift:=xlToRight Next End Sub （Lila） 2015/10/02(金) 16:14 ---- 私のほうは、急いでいませんので、そちらのペースで、ゆっくりやっていただいてOKです。 "非常" わぁ、へんな言葉ですね。 "非表示" のタイプミスです。 コメントもらった内容を、ゆっくりと分析してみます。 （β） 2015/10/02(金) 18:18 ---- >>Ctrl+PgDnなどの操作を品番列で実行すると、本来なら文字ある最終列に行くと思うのですが、 >>何故か最後尾（A1048576）のセルへ行ってしまい、今度はCtrl+PgUpをすると、「A5」セルへ行ってしまいます。 操作でこうなるということですね。マクロでも、結局は、この操作をコード化しているだけなので、 このシートの品番は A5 1行だけという認識になるのは、当然なんですが、なぜ、見た目と違うのかということですねぇ。 たとえば、A5の下のセルを選択して数式バーを見ると、ちゃんと目で見たものと同じ値が入っているということなんですよね。 であれば、操作でこういう結果にはならないはずです。 なるとしたら・・・・ A5の下のセル、常識的に考えると A6 ですが、これが A6 ではない?? そのセルを選択した時に、数式バーの左、名前ボックスには A6 と表示されてますか? ふつうはそうでしょうけど、たとえば A5:B5 が結合されていて A列のセル幅が0 なら、A5 を選択すると名前ボックスには、確かにA5 とでて数式バーには、その値が表示される。 でも、その下のセルを選択すると、セル内の値は数式バーに表示されているけど名前ボックスは A6 ではなく B6 になっている。 この状態では A6 は空白。 まぁ、極端なことをいっていますが、そういった特殊な状況以外に、Ctrl/↑ 等の操作の結果の 説明がつかないですねぇ。 （β） 2015/10/02(金) 21:10 ---- 繰り返しになりますが >>Ctrl+PgDnなどの操作を品番列で実行すると、本来なら文字ある最終列に行くと思うのですが、 >>何故か最後尾（A1048576）のセルへ行ってしまい、今度はCtrl+PgUpをすると、「A5」セルへ行ってしまいます。 ここがキーポイントだろうと思います。 たとえば、アップロードサービス等を利用して ブックをアップしてもらって、それをこちらでダウンロードできるなら 検証できるのですが、いかんせん、想像しかできませんので。 データがあるのに、エクセルは、あると認識してくれない。当然マクロもあるとは認識しない。 どういった状況の時に、こういったケースになってしまうのか? （↑でかなり苦しいケースをコメントしましたが） もう1つ、データがない（と思われる）のに、そこにデータがあると認識されるケース。 これは、いろいろ考えられますね。たとえば【グレーアウト】。背景色のことだったんですね。 ・セルの背景色をグレーにします。 ・文字色もグレーにします。 これで、一見、何もないように見えますが、そこには文字があります。 この文字はセルを選択すれば数式バーに表示されますから確認できますね。 ただ、以下の設定を行えば数式バーにも表示されません。 ・セル書式で表示しない にチェック ・その上で、シート保護 こうしておけば、セル選択しても、文字が見えませんので、全く空っぽのセルだと誤解してしまいますが 確実に、そのセルには値がありますね。 （β） 2015/10/03(土) 06:11 ---- こうなっているということではなく、可能性としては。 新規ブックに以下のマクロをコピペして実行してみてください。 A2 に値があるように見えますが、A2 は空白で、実際に値があるのは B2 です。 また、F1 には 値がないように見えますが、実際には ABCD と入っています。 Sub 不思議() Columns("B").ColumnWidth = 0.5 Range("A1").Value = "aaaaaaaa" Range("B2").Value = "bbbbbbbb" Range("B2").HorizontalAlignment = xlRight Range("F1").Value = "ABCD" Range("F1").Interior.Color = 13553360 Range("F1").Font.Color = 13553360 End Sub （β） 2015/10/03(土) 08:14 ---- 横から済みません。本格的な参加は出来ないのですけど・・・ Lilaさんのデータ状況が不明確なために、いたずらにエネルギーを消費している様な印象を受けます。 よろしければ、以下のプログラム（※）を使って、データ状況を明確に伝達しあっては如何でしょうか? ※『「シートのレイアウトとデータを再現するマクロ」を自動的に書く』マクロです。 --------------Lilaさんサイドの使い方----------------------------- 1.新規ブックを作成する。 2.そこに標準モジュールを1枚挿入する。 3.そのモジュールに後記マクロをコピペする 4.目的のシートのセル範囲をドラッグ選択する 今回のケースでは、空白と見える部分もチェックする必要があるので、 空白エリアも選択範囲に含めてください。 ・・とは云え、200行x78列がリミットです。 5.マクロ名「レイアウトとサンプルデータ再現マクロ作成」を実行する すると、自動作成されたマクロコードが、クリップボードに記憶された状態になっていますので、 ここの掲示板の返信欄とか(メモ帳とかに）右クリック→貼り付け を行って送信する ※作成されたマクロは、以下のような体裁になっています。 Private Sub onlyOnce() Rem 結合状態を処理 : : Rem 数式セルをまとめて処理 : : Rem 標準外書式セルをまとめて処理 : : Rem 塗りつぶしセルをまとめて処理 End Sub -------------回答サイドの使い方----------------------------------- Lilaさんから連絡されたマクロ(onlyOnce）を自ブックのシートモジュールにコピペして、実行すれば Lilaさんと同じシート状況が再現できます。 ※風雪に耐えたマクロじゃないので、これが新たな頭痛を生まないことを祈ります。 逆に、今回使えたら、かなり信頼性が増すことになります。 ' -----------コピペするマクロ------------------------------------------- Public Sub レイアウトとサンプルデータ再現マクロ作成() Const modelMRG As String = " Range(""Adrs"").Merge" Const modelCLR As String = " Range(""Adrs"").Interior.ColorIndex = " Const modelVAL2 As String = " Range(""Adrs"").Value = " Const modelFML As String = " Range(""Adrs"").FormulaR1C1Local = " Const modelFMT As String = " Range(""Adrs"").NumberFormatLocal = ""@""" '文字列(頭が「'」のデータ処理 Const modelFME As String = " Range(""Adrs"").NumberFormatLocal = " '標準外の表示形式 Dim WSF As WorksheetFunction Dim rslt Dim dataToFil Dim cel As Range Dim Codes As String Dim NN As Long, PP As Long Dim BlocksToRight As Long, BlocksToBottom Dim rngSelected As Range Set rngSelected = Intersect(Selection, Selection.Parent.UsedRange) If rngSelected.Rows.Count > 200 Or _ rngSelected.Columns.Count > 78 Then MsgBox "範囲が広すぎます" Exit Sub End If Set WSF = WorksheetFunction On Error Resume Next ThisWorkbook.Sheets("出力Wsh").Range("A1").Value = Empty 'シート存在テスト If Err.Number <> 0 Then ThisWorkbook.Sheets.Add.Name = "出力Wsh" End If On Error GoTo 0 NN = 0 With ThisWorkbook.Sheets("出力Wsh") NN = NN + 1: .Cells(NN, 1).Value = "Private Sub onlyOnce()" NN = NN + 1: .Cells(NN, 1).Value = "Rem ' Range(""" & rngSelected.Address(, , , True) & """).Clear" NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 結合状態を処理" For Each cel In rngSelected '結合状態を処理---------------- With cel If .MergeCells Then '結合状態になっているセルを処理 If .MergeArea.Item(1).Address = .Address Then NN = NN + 1 dataToFil = Replace(modelMRG, "Adrs", .MergeArea.Cells.Address(0, 0)) ThisWorkbook.Sheets("出力Wsh").Cells(NN, 1).Value = dataToFil End If End If End With Next NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 数式セル以外をまとめて処理" rslt = sameKindS(rngSelected, modelVAL2, "値") For PP = LBound(rslt) To UBound(rslt) If rslt(PP) <> Empty Then NN = NN + 1: .Cells(NN, 1).Value = rslt(PP) End If Next PP NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 数式セルをまとめて処理" rslt = sameKindS(rngSelected, modelFML, "数式") For PP = LBound(rslt) To UBound(rslt) If rslt(PP) <> Empty Then NN = NN + 1: .Cells(NN, 1).Value = rslt(PP) End If Next PP NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 標準外書式セルをまとめて処理" rslt = sameKindS(rngSelected, modelFME, "セル書式") For PP = LBound(rslt) To UBound(rslt) If rslt(PP) <> Empty Then NN = NN + 1: .Cells(NN, 1).Value = rslt(PP) End If Next PP NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 塗りつぶしセルをまとめて処理" rslt = sameKindS(rngSelected, modelCLR, "塗りつぶし") For PP = LBound(rslt) To UBound(rslt) If rslt(PP) <> Empty Then NN = NN + 1: .Cells(NN, 1).Value = rslt(PP) End If Next PP NN = NN + 1: .Cells(NN, 1).Value = "End Sub" .Range("A1").Resize(NN, 1).Copy End With End Sub Private Function sameKindS(rng As Range, modelFMS, Optional aim As String = "値") '一般形 Dim dic As Object Dim cel As Range Dim Adrs As String Dim AdrsBreak Dim sNum As String Dim eachKey Dim NN As Long Dim dataToFil Dim ItemVal Set dic = CreateObject("Scripting.Dictionary") ' 連想配列の定義 For Each cel In rng ItemVal = Empty Select Case aim Case "値" If Not cel.HasFormula And Not IsEmpty(cel.Value) Then ItemVal = IIf(IsError(cel.Value2), cel.Formula, cel.Value2) End If Case "数式" If cel.HasFormula Then ItemVal = cel.FormulaR1C1Local End If Case "セル書式" If cel.NumberFormatLocal <> "G/標準" And _ TypeName(cel.Value) <> "Currency" Then '標準外の書式を反映させる。通貨型は面倒なので処理外 ItemVal = cel.NumberFormatLocal End If Case "塗りつぶし" If cel.Interior.ColorIndex <> -4142 Then '塗りつぶしがあるセルを処理 ItemVal = cel.Interior.ColorIndex End If End Select If Not IsEmpty(ItemVal) Then If dic.Exists(ItemVal) Then AdrsBreak = Split(dic(ItemVal), "#") sNum = AdrsBreak(0) + 1 dic(ItemVal) = sNum & "#" & AdrsBreak(1) & cel.Address(0, 0) & " " Else dic.Add ItemVal, "1#" & cel.Address(0, 0) & " " End If End If Next Dim rslt() Dim brd ReDim rslt(0 To Application.Max(0, dic.Count - 1)) NN = 0 For Each eachKey In dic AdrsBreak = Split(dic(eachKey), "#") Adrs = Replace(RTrim(AdrsBreak(1)), " ", ",") Adrs = AddressUnited(Adrs) 'バラバラのAddressを統合 For Each brd In Split(Adrs, "#!#") If brd <> "" Then dataToFil = IIf(Application.IsText(eachKey), """", "") & Replace(eachKey, """", """""") & _ IIf(Application.IsText(eachKey), """", "") dataToFil = Replace(modelFMS, "Adrs", brd) & dataToFil NN = NN + 1 If NN - 1 > UBound(rslt) Then ReDim Preserve rslt(0 To NN - 1) End If rslt(NN - 1) = dataToFil End If Next Next sameKindS = rslt End Function Private Function AddressUnited(adr) 'バラバラのAddressを統合 Dim scopeRange As Range Dim adrRemain As String Dim adrForRowProc As String Dim adrForColProc As String Set scopeRange = Range(Split(adr, ",")(0)) adrRemain = "," & adr & "," Do While Not scopeRange Is Nothing uniteRowDir scopeRange, adrRemain adrForRowProc = adrForRowProc & scopeRange.Address(0, 0) & "," If Len(adrRemain) < 4 Then Set scopeRange = Nothing Else Set scopeRange = Range(Split(adrRemain, ",")(1)) End If Loop Set scopeRange = Range(Split(adrForRowProc & ",", ",")(0)) adrRemain = "," & adrForRowProc Do While Not scopeRange Is Nothing uniteColDir scopeRange, adrRemain adrForColProc = adrForColProc & scopeRange.Address(0, 0) & "," If Len(adrRemain) < 4 Then Set scopeRange = Nothing Else Set scopeRange = Range(Split(adrRemain, ",")(1)) End If Loop AddressUnited = get小分け(adrForColProc) '10セル以上は長いので同じ構文でも分割作成 End Function Function get小分け(adrForColProc) Dim strSRC Dim brDown, Cntr, sss, QQ, adrsUnit, numOfadrs brDown = Split(adrForColProc, ",") numOfadrs = UBound(brDown) '対象個数 adrsUnit = Int((numOfadrs - 1) / 10) + 1 adrsUnit = Application.RoundUp(UBound(brDown) / adrsUnit, 0) 'まとめるアドレスの数 For Cntr = 0 To numOfadrs - 1 Step adrsUnit sss = stEd(Cntr, Application.Min(numOfadrs - 1, Cntr + adrsUnit - 1), brDown) strSRC = IIf(strSRC = "", sss, strSRC & "#!#" & sss) Next Cntr get小分け = strSRC & "#!#" End Function Function stEd(st, ed, ary) Dim NN, str str = ary(st) For NN = st + 1 To ed str = str & "," & ary(NN) Next NN stEd = str End Function Private Sub uniteRowDir(ByRef scopeRange, ByRef adrRemain) Dim brdAry brdAry = Split(adrRemain, ",") adrRemain = Replace(adrRemain, "," & brdAry(1) & ",", ",") 'アドレス文字列から除外 If Range(brdAry(1)).Cells(1, 2).Address(0, 0) = brdAry(2) Then '右横に同じものあり Set scopeRange = Range(scopeRange, Range(brdAry(2))) uniteRowDir scopeRange, adrRemain End If End Sub Private Sub uniteColDir(ByRef scopeRange, ByRef adrRemain) '直下が同じ範囲かチェック Dim brdAry Dim adrsUnder As String brdAry = Split(adrRemain, ",") adrRemain = Replace(adrRemain, "," & scopeRange.Rows(scopeRange.Rows.Count).Address(0, 0) & ",", ",") 'アドレス文字列から除外 adrsUnder = scopeRange.Rows(scopeRange.Rows.Count + 1).Address(0, 0) '結合セル対策 If adrRemain Like "*," & adrsUnder & ",*" Then '真下に同じものあり Set scopeRange = Range(scopeRange, Range(adrsUnder)) uniteColDir scopeRange, adrRemain End If End Sub '------------ここまで コピペ ------------------------------------------- （半平太） 2015/10/03(土) 19:31 ---- To 半平太さん これはいいですねぇ。 momoさんのレイアウトアップ用ユーティリティとともに、活用していきたいですね。 （β） 2015/10/04(日) 20:34 ---- βさんおはようございます。 ＞A5の下のセル、常識的に考えると A6 ですが、これが A6 ではない?? ＞ そのセルを選択した時に、数式バーの左、名前ボックスには A6 と表示されてますか? ちゃんと数式バー左のボックスにはそのセルの座標（A6ならA6）と表示されるんですよ・・・ でも、どういうわけかCtrl+↑or↓処理が出来ない状態です・・・。 （Lila） 2015/10/05(月) 08:56 ---- 半平太さんありがとうございます。 半平太さんのマクロを使用させていただいて、上限のものではないですが、範囲選択して実行してみました。 ＜結果シート＞ Private Sub onlyOnce() Rem ' Range("[00_データベース.xlsm]Sheet1!$A$1:$AC$9").Clear Rem 結合状態を処理 Range("A1:A4").Merge Range("B1:B4").Merge Range("C1:C4").Merge Range("D1:D4").Merge Range("E1:E4").Merge Range("F1:M1").Merge Range("N1:S1").Merge Range("F2:I2").Merge Range("J2:M2").Merge Range("N2:O2").Merge Range("P2:S2").Merge Range("F3:G3").Merge Range("H3:I3").Merge Range("J3:K3").Merge Range("L3:M3").Merge Rem 数式セル以外をまとめて処理 Range("A1").Value = "品番" Range("B1").Value = "品目" Range("C1").Value = "品名" Range("D1").Value = "英語品名" Range("F1").Value = "クッキー" Range("N1").Value = "Cクッキー" Range("T1").Value = "せんべい" Range("U1").Value = "あげもち" Range("V1").Value = "おかき" Range("W1").Value = "キャンディ" Range("X1").Value = "のど飴" Range("Y1").Value = "グミ" Range("Z1").Value = "クラッカー" Range("AA1").Value = "チップス" Range("AB1").Value = "うす焼き" Range("AC1").Value = "人形焼" Range("F2").Value = "プレーン" Range("J2").Value = "チョコ" Range("N2").Value = "ミックス" Range("P2").Value = "チョコチップ" Range("F3,J3,N3,P3").Value = "5枚" Range("H3,L3,O3,Q3").Value = "10枚" Range("R3").Value = "15枚" Range("S3").Value = "20枚" Range("F4,H4,J4,L4,N4:S4").Value = "袋" Range("G4,I4,K4,M4").Value = "箱" Range("A5").Value = "*EMC-13HK-3D" Range("B5").Value = "MP-*EMC-13HK-3D" Range("C5").Value = "●○" Range("A6").Value = "*IP085C-SDM5" Range("B6").Value = "MP-*IP085C-SDM5" Range("C6").Value = "●○○" Range("D6").Value = "●×" Range("A7").Value = "*M201400" Range("B7").Value = "MP-*M201400" Range("C7").Value = "○×△" Range("D7,C8").Value = "●×△" Range("A8").Value = "00021182" Range("B8").Value = "MP-00021182" Range("A9").Value = "00021205" Range("B9").Value = "MP-00021205" Range("C9").Value = "●○●" Range("D9").Value = "●○●○" Rem 数式セルをまとめて処理 Rem 標準外書式セルをまとめて処理 Range("A1:A9").NumberFormatLocal = "@" Rem 塗りつぶしセルをまとめて処理 Range("A1:AC4").Interior.ColorIndex = 48 Range("B5:D9").Interior.ColorIndex = 2 End Sub （Lila） 2015/10/05(月) 08:59 ---- ↑で結果シートを作成し、それに見合うようなデータブックを以下で作成して、取り込みをしましたが 正常に取り込みができています。 Private Sub onlyOnce() Rem ' Range("[NewBook.xlsx]Sheet1!$F$10:$U$27").Clear Rem 結合状態を処理 Range("P11:U11").Merge Range("P12:Q12").Merge Range("R12:U12").Merge Rem 数式セル以外をまとめて処理 Range("F10").Value = "品番" Range("M10").Value = "数量" Range("M11").Value = "せんべい" Range("N11").Value = "あげもち" Range("O11").Value = "人形焼" Range("P11").Value = "Cクッキー" Range("P12").Value = "ミックス" Range("R12").Value = "チョコチップ" Range("P13,R13").Value = "5枚" Range("Q13,S13").Value = "10枚" Range("T13").Value = "15枚" Range("U13").Value = "20枚" Range("P14:U14").Value = "袋" Range("F23").Value = "*EMC-13HK-3D" Range("M23").Value = 1 Range("N23").Value = 6 Range("O23").Value = 11 Range("P23").Value = 16 Range("Q23").Value = 21 Range("R23").Value = 26 Range("S23").Value = 31 Range("T23").Value = 36 Range("U23").Value = 41 Range("F24").Value = "*IP085C-SDM5" Range("M24").Value = 2 Range("N24").Value = 7 Range("O24").Value = 12 Range("P24").Value = 17 Range("Q24").Value = 22 Range("R24").Value = 27 Range("S24").Value = 32 Range("T24").Value = 37 Range("U24").Value = 42 Range("F25").Value = "*M201400" Range("M25").Value = 3 Range("N25").Value = 8 Range("O25").Value = 13 Range("P25").Value = 18 Range("Q25").Value = 23 Range("R25").Value = 28 Range("S25").Value = 33 Range("T25").Value = 38 Range("U25").Value = 43 Range("F26").Value = 21182 Range("M26").Value = 4 Range("N26").Value = 9 Range("O26").Value = 14 Range("P26").Value = 19 Range("Q26").Value = 24 Range("R26").Value = 29 Range("S26").Value = 34 Range("T26").Value = 39 Range("U26").Value = 44 Range("F27").Value = 21205 Range("M27").Value = 5 Range("N27").Value = 10 Range("O27").Value = 15 Range("P27").Value = 20 Range("Q27").Value = 25 Range("R27").Value = 30 Range("S27").Value = 35 Range("T27").Value = 40 Range("U27").Value = 45 Rem 数式セルをまとめて処理 Rem 標準外書式セルをまとめて処理 Range("F10,F23:F27").NumberFormatLocal = "@" Rem 塗りつぶしセルをまとめて処理 Range("F10,M11:U14").Interior.ColorIndex = 48 End Sub （β） 2015/10/05(月) 09:51 ---- うーん・・・結果シートをもう一度新しく作成してみて、Ctrl+↑or↓が使えるようになるかを試してみた方が良さそうですね・・・。 そこがクリアすれば、まず結果シートは大丈夫そうですし・・・。 とりあえず、新規ブックでもう一度作成してみます。 （Lila） 2015/10/05(月) 13:03 ---- βさん、やりました! やはり、結果シートに何か問題があったようで、新規ブックで作成して、品番項目でCtrl+↑or↓が使用できるか確認した後、マクロを実行してみました所、データシート、結果シート共にデータ取得箇所、転記箇所間違いも無く、転記もされました! 大項目〜形状有のデータも、大項目のみのデータも、正常に転記できました! 長々とお付き合い頂き、本当にありがとうございました＞＜ βさんに頂いたコードの、test1の方でずっと検証していたのですが、test2の方も、同じ箇所のコード修正を行えば良いでしょうか? （Lila） 2015/10/05(月) 14:54 ---- ＞ >>Ctrl+PgDnなどの操作を品番列で実行すると、本来なら文字ある最終列に行くと思うのですが、 ＞ >>何故か最後尾（A1048576）のセルへ行ってしまい、今度はCtrl+PgUpをすると、「A5」セルへ行ってしまいます。 これがまた再現したのですが、恐らく、品番〜英品名（A列〜D列）を更新するマクロのせい（?）なのかもしれません。 1度目は大丈夫だけど、2度目からは何故かCtrl+↑or↓の操作が正常に出来なくなる（A5セルしか反応しない）現象が起きるようです。 色々な操作を組み合わせすぎて、何処かで不具合が生じているのかもしれませんね・・・。 ひとつのマクロに複数処理を組み込む時にやってはいけないコードの組み合わせ等ありますか? （Lila） 2015/10/05(月) 16:29 ---- とりあえず前進のようで、ほっとしています。 momoさんや半平太さんのユーティリティ、大助かりですね。ご両者に感謝。 >>test1の方でずっと検証していたのですが、test2の方も、同じ箇所のコード修正を行えば良いでしょうか? ん? 関連のプロシジャは Test1(そちらでは使用数更新1 という名前ですよね）、Test2(使用数更新2 ?) と データ取り込み の3つですけど、コード修正というのは、Test1 や Test2 に対するコード修正という意味ですか? もし、データ取り込み のコード変更のことなら、このプロシジャは 1つしかないので（Test1とTest2から共通で使われる） 【同じ箇所の修正】という意味がよくわからないのですが? >>Ctrl+PgDn 実は、本件ではないのですが、こちらのエクセルで 2000行程度の文字列をマクロで書きこんだ後に、一瞬ですけど Ctrl+PgDn で A1048576 をポイントして、あれ?? その時の操作、たまたま、そのあとブックを上書きして、 再度、Ctrl+PgDn で正常に戻りました。 操作の後で、あっ、これって、Lilaさんが言ってた現象だと、そう思いついたんですが、それ以降、こちらでは 発生しません。とにかく不思議ですよねぇ。 一度、発生した後、上書き保存してやると、どうなるでしょうね。 >>ひとつのマクロに複数処理を組み込む時にやってはいけないコードの組み合わせ等ありますか? う〜ん・・一般論としては、不整合が発生するコードの組み合わせはだめ、不整合が発生しなければOK。 具体的に、これとこれは不可とか、そうリストアップするのは、なかなか難しいです。 （β） 2015/10/06(火) 07:13 ---- おはようございます。 ＞ 【同じ箇所の修正】という意味がよくわからないのですが? test1と2を別のモジュールに置いているので、 ＞（β） 2015/09/30(水) 18:38 ＞（β） 2015/10/01(木) 22:18 この二つで変更と仰っていた箇所の修正の事です。 ＞ 一度、発生した後、上書き保存してやると、どうなるでしょうね。 こちらでは、元々使用していた結果シート同様、A5からA1048576へ飛んでしまいますね・・・。 Ctrl+Sでも、「上書き保存」を選んでも駄目でした。 ＞ う〜ん・・一般論としては、不整合が発生するコードの組み合わせはだめ、不整合が発生しなければOK。 ＞ 具体的に、これとこれは不可とか、そうリストアップするのは、なかなか難しいです。 不整合・・・ちょっと判らないですけど、とりあえず、ちょっとコードを見直してみてUPするので、見てもらっても良いですか; あ、スレ違いになっちゃいますかね? （Lila） 2015/10/06(火) 08:40 ---- >>test1と2を別のモジュールに置いているので、 シートモジュールですか? 標準モジュールですか? 後者ですよね。 別モジュールに配置してもいいのですが、Sub データ取り込み(shF As Worksheet) も、どこかの標準モジュールにあれば たとえ、それとは別の標準モジュールに Test1 や Test2 が配置されていたとしても、使うことができます。 いいかえれば、データ取り込み は マクロブックの中で 1つだけあればいいということです。 1つの専用の標準モジュールをつくって、そこに Test1,Test2,データ取り込み だけを配置しておくと 見やすいとは思いますが。 >>あ、スレ違いになっちゃいますかね? いえ、構わないですよ。 （β） 2015/10/06(火) 09:28 ---- データ取り込みはひとつのモジュールに置いておく事が可能なのですね。 現在は、更新、データ取り込み、 Private Function 〜のコードをそれぞれtest1と2の標準モジュールを作成して置いています。 ＞ いえ、構わないですよ。 ありがとうございます! 一応、何がやりたいのかと言うと、結果シートのA列とB列に「品目」をそれぞれ「品番」「品目」として、データシート（品目、品名、英語品名などの一覧）から転記して、C列に「品名」D列に「英語品名」を転記した後、A列の「品番」の頭3文字を削除する、という処理をしています。 こちらのデータシートはレイアウト固定で、随時更新が行われる為、どんどん増えていくものです。 ＜データシート＞ |[A] |[B] |[C] |[D] ・・・ [1]|品目 |品名 |英語品名 |品目タイプ [2]|MP-*E023550 |○○ |○○ |〜〜〜 [3]|MP-*IP035782|△△ |△△ |〜〜〜〜〜 [4]|MP-●○ | | | ＜結果シート・転記前＞ |[A] |[B] |[C] |[D] | [1]| | | | | [2]|品番 |品目 |品名 |英語品名 | [3]| | | | | [4]| | | | | [5]| | | | | [6]| | | | | ＜結果シート・転記後＞ |[A] |[B] |[C] |[D] | [1]| | | | | [2]|品番 |品目 |品名 |英語品名 | [3]| | | | | [4]| | | | | [5]|*E023550 |MP-*E023550 |○○ |○○ | [6]|*IP035782 |MP-*IP035782 |△△ |△△ | （Lila） 2015/10/06(火) 09:54 語句間違えの為、修正 10:11 ---- ＞（Lila） 2015/10/02(金) 16:14 に書いたコードが元のコードです。 で、同じ処理の変数を宣言していたので、そこを削っただけなのですが・・・ Sub 更新() '変数を宣言 Dim fn As String Dim wb As Workbook Dim re, a1 As Range '品番取得 fn = ThisWorkbook.Path & "¥保守リスト.xlsx" Application.ScreenUpdating = False Set wb = Workbooks.Open(fn) With wb.Worksheets("リスト") .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Copy End With ThisWorkbook.Sheets("Sheet1").Range("A5").PasteSpecial Paste:=xlPasteValues '品目、品名、品番更新 With wb.Worksheets("リスト") .Range("A2:C" & .Range("A" & Rows.Count).End(xlUp).Row).Copy End With ThisWorkbook.Sheets("Sheet1").Range("B5").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False wb.Close False Application.ScreenUpdating = True ' 文字削除 Set re = CreateObject("VBScript.RegExp") re.Pattern = "MP-" Range("A:A").Select For Each a1 In Selection a1.Value = re.Replace(a1.Value, "") Next Set re = Nothing End Sub これでも、動くことは動くのですが、やはりCtrl+↑or↓がA5からA1048576へ飛んでしまいます。 （上書きも試してみましたが、やはり変わらずA5しか認識されていませんでした） 元々のコードは、別の場所で聞いたり、本やネットで調べたりしながら書いたものです。 参考:http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q13149887793 http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q11150010026 （Lila） 2015/10/06(火) 10:07 語句修正 10:16 ---- >>データ取り込みはひとつのモジュールに置いておく事が可能なのですね。 はい。ただし データ取り込み は、Private Sub ではなく Sub で記述してくださいね。 アップされたコードは、今から見てみます。 （β） 2015/10/06(火) 10:19 ---- どうも悪さをしているのは、文字削除の部分のようです。 試しに、コメント表示にして実行してみた所、ちゃんと認識されていました。 Selectはあまり使わない方が良いと見たので、以前βさんが教えてくださったEnd(xlUp)の方式で合わせてみます。 （Lila） 2015/10/06(火) 10:36 ---- とりあえずコード拝見。 正規表現を使って変換するのは、だめではないですが、その変換領域を A列全体にしていますよね。 すごく時間がかかっていませんか? 1行目から1048576行目までの処理になっていますよ。 これで、空白セルがおかしくなることはないはずですが、もったいないですよね。 それと、1セル毎に正規表現で変換しなくても、該当領域を 通常のReplaceメソッドで変換すれば 一発で処理可能ですよ。 Set re = CreateObject("VBScript.RegExp") re.Pattern = "MP-" Range("A:A").Select For Each a1 In Selection a1.Value = re.Replace(a1.Value, "") Next Set re = Nothing これをなくして Range("A2", Range("A" & Rows.Count).End(xlUp)).Replace What:="MP-", Replacement:="", LookAt:=xlPart この1行でOKです。（★) これに変更して、更新処理をして、Ctrl+pgDn をやってみるとどうなりますか? (コメントしたように正規表現で最終セルまで処理しても空白セルがおかしくなることはないのですが念のため） (★) ただし、もし、この時点で、おかしな状態になっていれば、処理は A2 のみになるかもしれませんが） ということで、アップされたコードは効率が悪いですが、これで、おかしな現象がでるとは思えません。 （保守リスト.xlsxの"リスト"シート、そのものが、空白セルのところにスペースが入っているとか、そういうことがない限り） （β） 2015/10/06(火) 11:17 ---- ↑ もしかして正規表現を使った意図は、【先頭にある】MP- だけを消したかったということでしたか? ということを正規表現を使って処理するとしても、A列すべてではなく、領域限定するべきですね。 （β） 2015/10/06(火) 11:40 ---- うわぁ!すごいですね・・・一瞬で処理終了しました・・・。 流石です!ありがとうございます＞＜ 前のコードはすごく時間がかかっていたし、その間（応答していません）となっていたので、これも原因のひとつかなぁと思いました。 データシートは、サーバーからCSVで落としてきたものを、エクセル用に保存しなおす作業はしていますが、それ以外は触っていないので、空白は無いかな?と思います。 （元々入っていれば別ですが） Ctrl+pgDnも正常に動いています! カッコ内のRangeの前に「.」を付けないこともあるのですね・・・ まだまだVBAについて勉強する事は多いです・・・! ＞ということで、アップされたコードは効率が悪いですが、これで、おかしな現象がでるとは思えません。 うーん・・・何でしょうね。 謎ですが、恐らくこの削除コードが何か悪さをしていて、A5セルしか認識されていなかったのだと思われます。 削除コードをコメントにしてCtrl+pgDnしてみた所、ちゃんと文字の入ったセルの最終行まで飛んだので・・・。 （重くなって、応答していませんとなっていた事が原因のような気もしました） ＞↑ もしかして正規表現を使った意図は、【先頭にある】MP- だけを消したかったということでしたか? ＞ ということを正規表現を使って処理するとしても、A列すべてではなく、領域限定するべきですね。 そうです。 品番にMP-をつけたものが、品目になるので、そこから「MP-」（必ず先頭についている）を削除したかったのです。 そうですね・・・限定の方法が xlUp や xlDn を使用するのは色々なページや本を見てわかったのですが、記述がいまいちわからずにA列全体を指定してしまっていました。 判りやすい本が見つからないので、つぎはぎみたいな知識で作ってました; 目的のものに、ようやくたどり着けました＞＜ それもこれもβさんのお陰です! 本当に、ありがとうございました・・・!!!! （Lila） 2015/10/06(火) 11:55 ---- >>カッコ内のRangeの前に「.」を付けないこともあるのですね・・・ いえいえ、これは手抜きです。そちらのコードで、そうなっていたので、それを継承。 やはり、ThisWorkbook.Sheets("Sheet1").Range(・・) がいいですよ。 ところで。 もし先頭ではなく品目の真ん中あたりに MP- があって、これは変換したくないということなら正規表現を使って 以下のようにも処理可能です。 Set re = CreateObject("VBScript.RegExp") re.Pattern = "(¥n)MP-" re.Global = True With Range("A2", Range("A" & Rows.Count).End(xlUp)) .Value = WorksheetFunction.Transpose(Split(Mid(re.Replace(vbLf & Join(WorksheetFunction.Transpose(.Cells), vbLf), "$1"), 2), vbLf)) End With Set re = Nothing （β） 2015/10/06(火) 12:28 ---- ＞ いえいえ、これは手抜きです。そちらのコードで、そうなっていたので、それを継承。 ＞ やはり、ThisWorkbook.Sheets("Sheet1").Range(・・) がいいですよ。 なるほどです。 確か、見ていた所がTOPにはつけなくてもいいみたいな事が書かれていたから付けなかったんだと思います。 ＞もし先頭ではなく品目の真ん中あたりに MP- があって、これは変換したくないということなら正規表現を使って 以下のようにも処理可能です。 これはつまり、A200とかに消したくないものがあったという時の場合という事でしょうか? 今後、何かしら使いそうな気配のあるコードですね! メモして取っておきます! ありがとうございます^o^ （Lila） 2015/10/06(火) 13:05 ---- たとえば MP-abcMP-567 というのがあったら、abcMP-567 と、先頭のMP- だけをカットしたい場合ということです。 提示した Replaceメソッドでは abc567 になってしまいますので。 で、そういうこともありうるなら、正規表現を使って処理しなきゃいけないなぁということで 正規表現を使ったコードを参考までアップしました。 アップ後、よく見なおすと、無駄なことをしている部分もありました。 以下のほうがよかったかなと。 いずれにしても、解決しそうですね。ほっとしています。 Set re = CreateObject("VBScript.RegExp") re.Pattern = "^MP-|(¥n)MP-" re.Global = True With Range("A2", Range("A" & Rows.Count).End(xlUp)) .Value = WorksheetFunction.Transpose(Split(re.Replace(Join(WorksheetFunction.Transpose(.Cells), vbLf), "$1"), vbLf)) End With Set re = Nothing （β） 2015/10/06(火) 13:25 ---- ＞たとえば MP-abcMP-567 というのがあったら、abcMP-567 と、先頭のMP- だけをカットしたい場合ということです。 ＞ 提示した Replaceメソッドでは abc567 になってしまいますので。 「MP-」が先頭でなくても「MP-]と合致するものは全て削除という風になっているという事ですね。 もしかしたらないとは言い切れないので、こちらのコードに書き換えて、もう一度実行してみます。 ところで、品目列（B列）は必ず「MP-」が付いているので、自動的に文字列になるのですが、品番列（A列）で、「MP-」を削除してしまうと数値のみになってしまったり（これはまあ、右よりになってしまい、見栄え的に悪いというだけですが）「8-1905」となっているものが、日付として「Aug-05」等と変換されてしまったりするので（こちらは明らかにデータが変わってしまうので）、最初から文字列指定をしておきたいのですが、以下のコードをEnd Sub前に置いておくで大丈夫でしょうか? Selection.NumberFormat = "@" '文字列指定にする （Lila） 2015/10/06(火) 13:37 ---- ＞（β） 2015/10/06(火) 13:25 こちらのコードに書き換えて、実行してみました。 最初、変数を「Range」で宣言していたのでエラーが出てしまいましたが「Object」に変えたらばっちりでした。 ありがとうございます! 範囲指定の後に「.NumberFormat = "@" '文字列指定にする」を置いてみたら、なんとなく文字列になった気がします。 （Lila） 2015/10/06(火) 14:25 ---- 了解です。 また、壁にであったらSOSを出して下さい。 （β） 2015/10/06(火) 14:36 ---- βさん、本当にありがとうございました! またわからない事が出ましたら、こちらの掲示板を利用させていただこうと思います。 （Lila） 2015/10/06(火) 14:42 ---- こんにちは。 まだ見ておられるでしょうか。 ＞ カッコ内のRangeの前に「.」を付けないこともあるのですね・・・ ＞ まだまだVBAについて勉強する事は多いです・・・! 気を悪くせず聞いて欲しいのですが、勉強の仕方がへたです。 せっかくがんばっているのに、それじゃもったいないです。 ここで学ぶべきは、なぜ「.」を付けないといけないかです。それだけです。 そこが分かれば（頭で理解するだけでなく、肚まで落として納得できれば） 次回からは、with なんちゃら と書いたら次の行はもう「.」を付けたく て付けたくて仕方なくなります。（言い過ぎか（笑）、ときどき付け忘れ ますのであまり大きなことは言えません） 「.」を付けないケースについても、「付けるべきでないから付けない」 と言えるようになります。 （ 佳 ） 2015/10/07(水) 00:04 ---- ＞佳さん ありがとうございます。 大体のネット情報や本に言える事ですが、「基本は知ってるよね」ってスタンスが多いような気がします。 基本を学べる環境が少ないので、どうにもなぜ付けるのか付けるべきじゃないのかという所が不明確なのです。 エクセル業務を行うなら、マクロを組めればだいぶ仕事が速くなる事も多いので、これからも勉強して行きます。 （Lila） 2015/10/07(水) 10:58 ---- コメントありがとうございます。 じゃあ、ここで質問すればいいですよ（^^ なぜ「.」が必要なのか。 そんなスタンスで回答されるかたはいらっしゃいませんし（と思う） なんなら「存じません、教えてください」と返せばいいだけですし。 しっかり理解できるまでとことん教われます。 ＞ 大体のネット情報や本に言える事ですが、「基本は知ってるよね」ってスタンスが多いような気がします。 う〜ん。 エクセルVBA関連の本はよく読んでいるほうだと思いますが、 そんなスタンスの入門書は見たことがありません。 あ、入門書以外ならもちろんそういうスタンスです。 その本が対象としている読者のレベルってありますから。 当然ですね。 （ 佳 ） 2015/10/07(水) 19:42
... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201509/20150930112510.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97032 documents and 608003 words.
訪問者：