Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

29 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【81925】Re:所定フォームへの流し込み

マナ - 22/1/22(土) 23:22 -


	引用なし

	パスワード

▼ackkn さん：

代わり映えしませんが

Sub test()
　　Dim r1 As Range
　　Dim r2 As Range
　　
　　Set r1 = Range("B6")
　　Set r2 = r1

　　Do
　　　　Set r2 = r2.Offset(4)
　　　　If r2.Value <> r1.Value Then
　　　　　　Range(r1, r2.Offset(-1)).Merge
　　　　　　r1.HorizontalAlignment = xlCenter
　　　　　　If r2.Value = "" Then Exit Do
　　　　　 Set r1 = r2
　　　　Else
　　　　　　r2.ClearContents
　　　　End If
　　Loop
　　
End Sub

・ツリー全体表示


	【81924】Re:所定フォームへの流し込み

ackkn - 22/1/22(土) 21:48 -


	引用なし

	パスワード

▼マナさん

得意先の列(B列)の場合です。C列も同様です。

'--- 得意先(B列)の結合
　　Rc = 6
　　Do While 1
　　　　If Rc = 6 Then
　　　　　　Tokui = Cells(Rc, 2).Value
　　　　　　Rm = Rc
　　　　　　Rc = Rc + 4
　　　　Else
　　　　　　If Cells(Rc, 2).Value = Tokui Then
　　　　　　　　Rc = Rc + 4
　　　　　　Else
　　　　　　　　If Cells(Rc, 2).Value = "" Then
　　　　　　　　　　With Range("B" & Rm & ":B" & Rc - 1)
　　　　　　　　　　　　.Merge
　　　　　　　　　　　　.HorizontalAlignment = xlCenter
　　　　　　　　　　End With
　　　　　　　　　　Exit Do
　　　　　　　　Else
　　　　　　　　　　Tokui = Cells(Rc, 2).Value
　　　　　　　　　　With Range("B" & Rm & ":B" & Rc - 1)
　　　　　　　　　　　　.Merge
　　　　　　　　　　　　.HorizontalAlignment = xlCenter
　　　　　　　　　　End With
　　　　　　　　　　Rm = Rc
　　　　　　　　　　Rc = Rc + 4
　　　　　　　　End If
　　　　　 End If
　　　　End If
　　Loop

・ツリー全体表示


	【81923】Re:所定フォームへの流し込み

マナ - 22/1/22(土) 21:35 -


	引用なし

	パスワード

▼ackkn さん：

>それと、申し訳ないですが、力ずくでは出来るのですが、

今度は何がしたいか、わかりません。
その力ずくのコードを提示してください。

・ツリー全体表示


	【81922】Re:所定フォームへの流し込み

ackkn - 22/1/22(土) 20:41 -


	引用なし

	パスワード

▼マナさんすいません、伝わっていないのは私でした。 w(dic(s) + 1, d) = v(k, 5) w(dic(s) + 1, d + 1) = v(k, 6) w(dic(s) + 2, d) = v(k, 7) それぞれに +1 すれば良かったんですね。ヒントが絶妙過ぎます。バッチリでした。それと、申し訳ないですが、力ずくでは出来るのですが、マナさんならスマートな方法で片付けられそうなので、スマートな方法お教えください。上記の方法で、一番上にズラした得意先名とセンター名の2列で、同じ得意先と同じセンター名のセルを結合したいのです。(下図) 得意先名　センター名　　　14日　　　　15日　　　　16日　　　　　　　　曜日　　　(火)　　　　(水)　　　　(木) ----------------------------------------------------------- 　A社　　 Aセンター｜　　　　　｜　　　　　｜　　　　　｜ ----------------------------------------------------------- 　↓　　　　↓　　　｜1,153｜　8｜　　｜　｜　　1｜　1｜　　　　 ----------------------------------------------------------- 　↓　　　　↓　　　｜　　3,800｜　　　　　｜　　　 100｜ ----------------------------------------------------------- 　↓　　　　↓　　　｜　　　　　｜　　　　　｜　　　　　｜ =========================================================== 　A社　　 Bセンター｜　　　　　｜　　　　　｜　　　　　｜ ----------------------------------------------------------- 　↓　　　　↓　　　｜　　　　　｜　　　　　｜　　　　　｜　　↑＿＿＿＿↑＿この2列

・ツリー全体表示


	【81921】Re:所定フォームへの流し込み

マナ - 22/1/22(土) 20:18 -


	引用なし

	パスワード

▼ackkn さん：

>すいません、やっぱり伝えれませんでした。

何がしたか伝わっていますよ。

　　dic(s) = dic.Count * 4
　　w(dic(s), 1) = v(k, 3)　 ←得意先名
　　w(dic(s), 2) = v(k, 4)　 ←センター名
End If
d = (Day(v(k, 1)) - 13) * 2 + 3
w(dic(s), d) = v(k, 5)　　　←ケース数
w(dic(s), d + 1) = v(k, 6)　 ←パレット数
w(dic(s) + 1, d) = v(k, 7)　 ←総数（kg）

変数wに値を代入するときに、
位置をずらせばよいです。
1次元目が行位置です。　　　　　　

w(行位置,列位置）

・ツリー全体表示


	【81920】Re:所定フォームへの流し込み

ackkn - 22/1/22(土) 19:21 -


	引用なし

	パスワード

▼マナさんすいません、やっぱり伝えれませんでした。 dic(s) = dic.Count * 4 + 1 として実行すると、得意先、センター名の見出し行に揃ってすべてが1行下にズレました。(下図) 得意先名　センター名　　　14日　　　　15日　　　　16日　　　　　　　　曜日　　　(火)　　　　(水)　　　　(木) ----------------------------------------------------------- 　　　　　　　　　　｜　　　　　｜　　　　　｜　　　　　｜ ----------------------------------------------------------- 　A社　　 Aセンター｜1,153｜　8｜　　｜　｜　　1｜　1｜　　　　 ----------------------------------------------------------- 　　　　　　　　　　｜　　3,800｜　　　　　｜　　　 100｜ ----------------------------------------------------------- 　　　　　　　　　　｜　　　　　｜　　　　　｜　　　　　｜ =========================================================== 　　　　　　　　　　｜　　　　　｜　　　　　｜　　　　　｜これを、下図のようにしたいんです。得意先名　センター名　　　14日　　　　15日　　　　16日　　　　　　　　曜日　　　(火)　　　　(水)　　　　(木) ----------------------------------------------------------- 　A社　　 Aセンター｜　　　　　｜　　　　　｜　　　　　｜ ----------------------------------------------------------- 　　　　　　　　　　｜1,153｜　8｜　　｜　｜　　1｜　1｜　　　　 ----------------------------------------------------------- 　　　　　　　　　　｜　　3,800｜　　　　　｜　　　 100｜ ----------------------------------------------------------- 　　　　　　　　　　｜　　　　　｜　　　　　｜　　　　　｜ =========================================================== 　　　　　　　　　　｜　　　　　｜　　　　　｜　　　　　｜　　↑　　　 ↑ その為に、 r2.Resize(dic.Count * 4, UBound(w, 2)).Value = w の行で w() を表示した後に、上の ↑ 2列を上に1行ズラした方が早いのでしょうか？

・ツリー全体表示


	【81919】Re:所定フォームへの流し込み

マナ - 22/1/22(土) 17:18 -


	引用なし

	パスワード

▼ackkn さん：

例えば、ケース数なら、下記行を修正してください。

＞w(dic(s), d) = v(k, 5)

v(k, 5)は、ケース数
dic(s)は、行位置
dは、列位置

・ツリー全体表示


	【81918】Re:所定フォームへの流し込み

ackkn - 22/1/22(土) 15:40 -


	引用なし

	パスワード

▼マナさん：

dic(s) = dic.Count * 4 + 1 とすると、

得意先、センター名の見出し行に揃ってすべてが1行下にズレたので、左2列の得意
先、センター名だけは各4行の一番上にしたいので、その場合、

r2.Resize(dic.Count * 4, UBound(w, 2)).Value = w

の後に、左2列の得意先、センター名だけを1行上にズラした方が早いのでしょうか？

・ツリー全体表示


	【81917】Re:所定フォームへの流し込み

マナ - 22/1/22(土) 14:05 -


	引用なし

	パスワード

▼ackkn さん：

>これは、下段のセルを結合していたためで、w(dic(s) + 1, d + 1) = v(k, 7)
>を、w(dic(s) + 1, d) = v(k, 7)に変更して解決しました。

これができたのだから、今回は、行と列が違うだけで、応用できませんか。

・ツリー全体表示


	【81916】Re:所定フォームへの流し込み

ackkn - 22/1/22(土) 12:42 -


	引用なし

	パスワード

マナさん

ありがとうございます。

> ReDim w(n * 4, 1 To r2.Columns.Count + 1)
> dic(s) = dic.Count * 4
> r2.Resize(dic.Count * 4, UBound(w, 2)).Value = w

にして実行したところ、やはり左2列の得意先とセンター名は4行セットでいいので
すが、その右が得意先とセンター名の行に揃ってしまい、駄目です。
前回の2行を上下に他の2行に挟まれたサンドイッチの4行なので、1行ずれています。

この説明で伝わるでしょうか？

・ツリー全体表示


	【81915】Re:所定フォームへの流し込み

マナ - 22/1/22(土) 9:20 -


	引用なし

	パスワード

▼ackkn さん：

>今回の2行（上下段）の上下に付随行があり、1つの得意先＋センター名に対して
>、4行単位なんです。　これに対応できません。

i下記3行の、「 * 2 」を修正してください。

> ReDim w(n * 2, 1 To r2.Columns.Count + 1)
> dic(s) = dic.Count * 2
> r2.Resize(dic.Count * 2, UBound(w, 2)).Value = w

>

・ツリー全体表示


	【81914】Re:所定フォームへの流し込み

ackkn - 22/1/21(金) 22:20 -


	引用なし

	パスワード

マナさんお世話になっております。会社のPCで再現がありました。　Excel2019です。ですが、元ネタの表がソート済でしたので、v = r1 として解決しました。完動したら、完動しました！　素晴らしいです！！で、あまりに高度なコードですので、ご相談なんですが、今回の所定表（13日～ 30日で固定）、実は少しフォームが違っていて、上段がケース数とパレット数で、下段が総数kgを入れる部分がミソで、この部分が分かれば、後はアレンジすればいいと思っていたのですが、前述の通りあまりに高度なコードなので、アレンジが出来ません。冒頭の v = r1 で、元ネタを配列 v に入れ、それで n = UBound(v) で行数を求め、ワーク配列 w() を Redim して、得意先　センター名を dictionary で重複取る部分も、dic(s) = dic.Count * 2 の1行で、Add を使わなくても追加できるんですね。　問題は、w() の使い方なんです。　最初、上段のケース数とパレット数だけが表示されて、下段の総数kgが全く表示されませんでした。これは、下段のセルを結合していたためで、w(dic(s) + 1, d + 1) = v(k, 7) を、w(dic(s) + 1, d) = v(k, 7)に変更して解決しました。最後に、r2.Resize(dic.Count * 2, UBound(w, 2)).Value = w で、所定表（13日～30日で固定）に戻す部分なんです、この部分が、実際の表は、今回の2行（上下段）の上下に付随行があり、1つの得意先＋センター名に対して、4行単位なんです。　これに対応できません。よろしくご教示ください。

・ツリー全体表示


	【81913】Re:所定フォームへの流し込み

マナ - 22/1/21(金) 19:30 -


	引用なし

	パスワード

▼ackkn さん：
>
>実行時エラー '1004':
>WorksheetFunction クラスの Sort プロパティを取得できません。

エクセルのバージョンを教えて下さい。

>　 Set r1 = Sheet1.Range("A1").CurrentRegion
>　 Set r2 = Sheet2.UsedRange.Offset(2)

Sheet1の部分は、Sheets("実際のシート名")に変更してください。
Sheet2の部分も同様です。

・ツリー全体表示


	【81912】Re:所定フォームへの流し込み

ackkn - 22/1/20(木) 11:31 -


	引用なし

	パスワード

マナ　様
早速ですが、確認しましたら、

　　v = WorksheetFunction.Sort(r1, 3)　の行で

下記エラーが出ました。

実行時エラー '1004':
WorksheetFunction クラスの Sort プロパティを取得できません。

よろしくお願いします。

・ツリー全体表示


	【81911】Re:所定フォームへの流し込み

ackkn - 22/1/20(木) 10:32 -


	引用なし

	パスワード

マナ様
お返事が遅くなって申し訳ありませんでした。
昨年は時間が無く、手作業で終えたものですから、本当に申し訳ありませんでした。
今から動作確認をしますので、改めて結果のご報告をいたします。

・ツリー全体表示


	【81910】Re:数行おきに範囲指定してdelete

たろまる - 22/1/13(木) 0:32 -


	引用なし

	パスワード

▼マナさん：
ありがとうございます
助かりました！

・ツリー全体表示


	【81909】Re:数行おきに範囲指定してdelete

マナ - 22/1/12(水) 19:46 -


	引用なし

	パスワード

▼たろまるさん：

ws.Cells(Rows.Count, "J").End(xlUp).Row

J列でデータが入力されている最終行

・ツリー全体表示


	【81908】Re:数行おきに範囲指定してdelete

たろまる - 22/1/12(水) 0:31 -


	引用なし

	パスワード

▼マナさん：
ありがとうございます、無事動作しました。ちなみになのですが、これはどこの行まで行う等はどの部分で指定しているのでしょうか？
差し支えなければ教えて頂けると助かります。

・ツリー全体表示


	【81907】Re:数行おきに範囲指定してdelete

マナ - 22/1/11(火) 23:07 -


	引用なし

	パスワード

▼たろまるさん：

Option Explicit

Sub test()
　　Dim ws As Worksheet
Dim k As Long
Dim u As Range, r As Range

　　For Each ws In Worksheets
　　　　Set u = Nothing
　　　　For k = 8 To ws.Cells(Rows.Count, "J").End(xlUp).Row Step 3
　　　　　　Set r = ws.Cells(k, "J").Resize(2, 12)
　　　　　　If u Is Nothing Then
　　　　　　　　Set u = r
　　　　　　Else
　　　　　　　　Set u = Union(u, r)
　　　　　　End If
　　　　Next
　　　　If Not u Is Nothing Then u.ClearContents
　　Next

End Sub

・ツリー全体表示


	【81906】数行おきに範囲指定してdelete

たろまる - 22/1/11(火) 21:09 -


	引用なし

	パスワード

J列からU列までの間でまず8,9行目を選択、１行あけて11、12行目を選択これを繰り返して一括でセルの数値を削除する方法はありますでしょうか？複数sheetがあり、最終行がバラバラのためそこの判断も良い方法がありましたら教えて頂けると助かります。
初歩的なことかもしれませんが、何卒よろしくお願い致します。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

29 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free