Excel VBA質問箱 IV

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

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


28 / 3841 ページ ←次へ | 前へ→

【81928】Re:シート間のデータコピーでエラー
発言  マナ  - 22/1/26(水) 16:24 -

引用なし
パスワード
   ▼ackkn さん:

>アプリケーション定義またはオブジェクト定義のエラーです。
>何が悪いのでしょうか? ご教示ください。

Offset と Resize をごっちゃにしていませんか。
Resizeの引数は、1以上でないとエラーです。
0にResizeできません。
・ツリー全体表示

【81927】シート間のデータコピーでエラー
質問  ackkn  - 22/1/26(水) 14:35 -

引用なし
パスワード
   また行き詰まりました。
下表をセンター納品日でシートを分けたくて、下記のコードを考えたのですが、

   A   B  C   D   E    F    G   H  I  J  K  L  M   N   O
1
2 センター納品日 得意先 センター 商品CD 商品名  数量 総ケース ケース バラ 積数 PL数 端数 ケース重量 総重量
3 12月7日 (火) A社  Aセンター  A  商品A  2,800  70  70  0  54 1.3  16   10  700
4 12月7日 (火) A社  Bセンター  A  商品A 12,480  312 312  0  54 5.8  42   10 3,120
5 12月7日 (火) A社  Cセンター  A  商品A  8,240  206 206  0  54 3.8  44   10 2,060
6 12月8日 (水) B社  Dセンター  B  商品B  2,356  59  58 36  54 1.1  5   10  590
7 12月9日 (木) C社  Eセンター  C  商品C   30   1  0 30  40 0.0  1   10   10
8 12月10日(金) D社  Fセンター  A  商品A  1,600  40  40  0  54 0.8  40   10  400

r1.Row が 3 で >>>行で下のエラーになります。

実行時エラー '1004':
アプリケーション定義またはオブジェクト定義のエラーです。

何が悪いのでしょうか? ご教示ください。
尚、Excel のバージョンは 2019 です。

Sub 処理()
  Dim ws, ws2, wsk As Worksheet
  Dim r1 As Range
  Dim i As Long
  Dim Mvc As Long
  Dim Rmax As Long
   
  Set ws = ActiveWorkbook.Worksheets("Sheet1")
  Set ws2 = ActiveWorkbook.Worksheets("Sheet2")
    
  ws.Activate
  Rmax = ws.Cells(Rows.Count, 3).End(xlUp).Row  'C列最下行
  Range("A2:P" & Rmax).Select
  With ws.Sort
    .SortFields.Clear
    .SortFields.Add2 Key:=Range("A3:A" & Rmax), SortOn:=xlSortOnValues, _
      Order:=xlAscending, DataOption:=xlSortNormal
    .SortFields.Add2 Key:=Range("C3:C" & Rmax), SortOn:=xlSortOnValues, _
      Order:=xlAscending, DataOption:=xlSortNormal
    .SortFields.Add2 Key:=Range("D3:D" & Rmax), SortOn:=xlSortOnValues, _
      Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange Range("A2:O" & Rmax)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .Apply
  End With
  Range("A2").Select

'--- データの移動 (日付9日未満のデータを「Sheet2」へ)
  Rmax = ws.Cells(Rows.Count, 1).End(xlUp).Row  'A列最下行を取得
  Mvc = 0
  For Each r1 In Range("A3:A" & Rmax)
    If Day(r1) < 9 Then
      Mvc = Mvc + 1
>>>     ws.Range("A3").Resize(r1.Row - 3, 14).Copy ws2.Range("A3")
    End If
  Next
  If Mvc <> 0 Then
    Range("A" & r1.Row + 1 & ":O" & Rmax).Copy Range("A3")
  End If
 
End Sub
・ツリー全体表示

【81926】Re:所定フォームへの流し込み
お礼  ackkn  - 22/1/22(土) 23:58 -

引用なし
パスワード
   ▼マナ さん:

>▼ackkn さん:
>代わり映えしませんが

何を仰います!

これです!、バッチリです!
よ〜〜く内容を理解して自分のものにしたいと思います。

理解できないところが出れば、質問させてください。
よろしくお願いします。

長々とありがとうございました。
・ツリー全体表示

【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列でデータが入力されている最終行
・ツリー全体表示

28 / 3841 ページ ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free