Excel VBA質問箱 IV

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

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


10263 / 13644 ツリー ←次へ | 前へ→

【22799】Sheet1のデータをSheet2に条件をつけて複... Sora 05/3/3(木) 18:26 質問[未読]
【22802】Re:Sheet1のデータをSheet2に条件をつけて... G-Luck 05/3/3(木) 19:02 発言[未読]
【22804】Re:Sheet1のデータをSheet2に条件をつけて... ichinose 05/3/3(木) 19:57 発言[未読]
【22806】Re:Sheet1のデータをSheet2に条件をつけて... ponpon 05/3/3(木) 22:52 発言[未読]
【22816】Re:Sheet1のデータをSheet2に条件をつけて... Sora 05/3/4(金) 10:56 質問[未読]
【22818】Re:Sheet1のデータをSheet2に条件をつけて... Jaka 05/3/4(金) 13:00 回答[未読]
【22838】間違えました。 Jaka 05/3/4(金) 17:31 回答[未読]
【22819】Re:Sheet1のデータをSheet2に条件をつけて... ichinose 05/3/4(金) 13:04 発言[未読]
【22845】Re:Sheet1のデータをSheet2に条件をつけて... Sora 05/3/4(金) 19:07 お礼[未読]

【22799】Sheet1のデータをSheet2に条件をつけて複...
質問  Sora  - 05/3/3(木) 18:26 -

引用なし
パスワード
   初めての質問になります。
お手数をお掛け致しますがよろしくお願い致します。

現在、Excel2000を使用して下記のようなリストを作っています。
下記のデータ(Sheet1)をSheet2に次の条件で複写したいのですが
どのようにすればよいでしょうか?

条件:Sheet1の各列のデータを"O"の値の数だけSheet2にコピーする。

<Sheet1>
  A   B  〜  N    O 
1 月日  品目   伝票No  数量 
2 10/01 棚  〜 伝票1   3
3 11/03 机  〜 伝票2   5
4 11/13 椅子 〜  伝票3  3


<Sheet2>(複写後にこのようになるようにしたいのですが…)
  A   B  〜  N    O 
1 月日  品目   伝票No  数量 
2 10/01 棚  〜 伝票1   1/3
3 10/01 棚  〜 伝票1   2/3
4 10/01 棚  〜 伝票1   3/3
5 11/03 机  〜 伝票2   1/5
6 11/03 机  〜 伝票2   2/5
7 11/03 机  〜 伝票2   3/5
8 11/03 机  〜 伝票2   4/5
9 11/03 机  〜 伝票2   5/5
10 11/13 椅子 〜  伝票3  1/3
11 11/13 椅子 〜  伝票3  2/3
12 11/13 椅子 〜  伝票3  3/3


よろしくお願い致します。

【22802】Re:Sheet1のデータをSheet2に条件をつけ...
発言  G-Luck  - 05/3/3(木) 19:02 -

引用なし
パスワード
   ▼Sora さん:
手前味噌になりますが、下記が参考になりませんか?

http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=22607;id=excel

【22804】Re:Sheet1のデータをSheet2に条件をつけ...
発言  ichinose  - 05/3/3(木) 19:57 -

引用なし
パスワード
   Sora さん、G-Luckさん、こんばんは。
>初めての質問になります。
>お手数をお掛け致しますがよろしくお願い致します。
>
>現在、Excel2000を使用して下記のようなリストを作っています。
>下記のデータ(Sheet1)をSheet2に次の条件で複写したいのですが
>どのようにすればよいでしょうか?
>
>条件:Sheet1の各列のデータを"O"の値の数だけSheet2にコピーする。
>
><Sheet1>
>  A   B  〜  N    O 
>1 月日  品目   伝票No  数量 
>2 10/01 棚  〜 伝票1   3
>3 11/03 机  〜 伝票2   5
>4 11/13 椅子 〜  伝票3  3
>
>
><Sheet2>(複写後にこのようになるようにしたいのですが…)
>  A   B  〜  N    O 
>1 月日  品目   伝票No  数量 
>2 10/01 棚  〜 伝票1   1/3
>3 10/01 棚  〜 伝票1   2/3
>4 10/01 棚  〜 伝票1   3/3
>5 11/03 机  〜 伝票2   1/5
>6 11/03 机  〜 伝票2   2/5
>7 11/03 机  〜 伝票2   3/5
>8 11/03 机  〜 伝票2   4/5
>9 11/03 机  〜 伝票2   5/5
>10 11/13 椅子 〜  伝票3  1/3
>11 11/13 椅子 〜  伝票3  2/3
>12 11/13 椅子 〜  伝票3  3/3
>
以下のコードは、Sheet1からSheet2にA列からN列までは値のみコピーしています。
よって、Sheet2のA列からN列は、適当な書式を設定して置いてください。
'================================================================
Sub test()
  Dim sht1 As Worksheet
  Set sht1 = Worksheets("sheet1")
  odx = 2 'sheet2の書き込み行
  For idx = 2 To sht1.Cells(sht1.Rows.Count, 1).End(xlUp).Row
    '↑idxは、Sheet1の行
   With Worksheets("sheet2")
    repcnt = sht1.Range("o" & idx).Value
    '↑繰り返し数の取得
    .Range(.Cells(odx, 1), .Cells(odx + repcnt - 1, 14)).Value = _
       sht1.Range(sht1.Cells(idx, 1), sht1.Cells(idx, 14)).Value
    'A列からN列はそのまま代入
    s_add = .Range("o" & odx).Address
    'sheet2のO列の書き込みセルの絶対アドレス
    With .Range(.Cells(odx, 15), .Cells(odx + repcnt - 1, 15))
     .NumberFormat = "0""/" & repcnt & """"
     .Formula = "=(row()-row(" & s_add & ")+1)"
     .Value = .Value
     End With
    odx = odx + repcnt
    End With
   Next idx
End Sub

悩んだのは、Sheet2のO列の書式をどうしようかと思いましたが・・・。
数量が文字列というのもなあと思い、数字を残しておきました。
確認して下さい。

【22806】Re:Sheet1のデータをSheet2に条件をつけ...
発言  ponpon  - 05/3/3(木) 22:52 -

引用なし
パスワード
   ▼Sora さん、G-Luckさん、ichinoseさん
>
>条件:Sheet1の各列のデータを"O"の値の数だけSheet2にコピーする。

ponponです。こんばんは。
sheet1をsheet2にコピーするのでデータが多いと遅くなると思います。
それと、5/5、3/3の書式がうまくいきませんでした。
参考にしてください。
Sub test()
  Dim i As Long
  Dim j As Long
  Dim T As Single
  Dim m As Single
   Application.ScreenUpdating = False
   Worksheets("sheet1").Cells.Copy
   With Worksheets("sheet2")
  
   .Range("A1").PasteSpecial
   
   For i = Range("O65536").End(xlUp).Row To 2 Step -1
    T = .Cells(i, "O").Value
     With .Cells(i, "O")
      For j = 1 To T - 1
        .EntireRow.Insert Shift:=xlDown
      Next j
       For m = 1 To T - 1
        .Offset(, -14).Resize(1, 14).Copy
        .Offset(-m, -14).PasteSpecial
        .Offset(-m, 0).NumberFormatLocal = "?/?"
        .Offset(-m, 0).Value = (T - m) / T
       Next m
       Application.CutCopyMode = False
      End With
   Next i
  End With

【22816】Re:Sheet1のデータをSheet2に条件をつけ...
質問  Sora  - 05/3/4(金) 10:56 -

引用なし
パスワード
   G-Luckさん、ichinoseさん、ponponさん、
いろいろとご回答有り難うございます。

皆さんに書いて頂いたことを参考にチャレンジしてみました。
そのなかで、ichinoseさんから頂いたご回答について
再度お伺いしたいことがありましたので、
大変に申し訳ありませんがご教授頂ければと思います。

お伺いしたいことについでですが…
ichinoseさんのVBを実行してみたところ、
結果としては満足できるように別シートに複写することができたのですが
その途中で「型が一致しません」というメッセージが表示されてしまいました。
デバックしたみたところ、下記の線で囲んでいるところが黄色くなり、
そこを修正しなければいけないようです。

ネットでいろいろと調べてみたのですが
どうしても自力で解決できませんでしたので、
もしこの件にお付き合い頂けるようでしたらご教授願えればと思います。


Sub test()
  Dim sht1 As Worksheet
  Set sht1 = Worksheets("sheet1")
  odx = 2 'sheet2の書き込み行
  For idx = 2 To sht1.Cells(sht1.Rows.Count, 1).End(xlUp).Row
    '↑idxは、Sheet1の行
   With Worksheets("sheet2")
    repcnt = sht1.Range("o" & idx).Value
    '↑繰り返し数の取得
----------------------------------------------------------------------
    .Range(.Cells(odx, 1), .Cells(odx + repcnt - 1, 14)).Value = _
       sht1.Range(sht1.Cells(idx, 1), sht1.Cells(idx, 14)).Value
----------------------------------------------------------------------
    'A列からN列はそのまま代入
    s_add = .Range("o" & odx).Address
    'sheet2のO列の書き込みセルの絶対アドレス
    With .Range(.Cells(odx, 15), .Cells(odx + repcnt - 1, 15))
     .NumberFormat = "0""/" & repcnt & """"
     .Formula = "=(row()-row(" & s_add & ")+1)"
     .Value = .Value
     End With
    odx = odx + repcnt
    End With
   Next idx
End Sub

【22818】Re:Sheet1のデータをSheet2に条件をつけ...
回答  Jaka  - 05/3/4(金) 13:00 -

引用なし
パスワード
   こんにちは。
おじゃまします。

全く違う方法ですが....。
P列を作業列に使ってます。
不都合でしたら、適当な列に変更してください。

Sub hsdndh()
  Dim S2ER As Long, i As Long
  Application.ScreenUpdating = False
  Sheets("Sheet1").UsedRange.Copy
  With Sheets("Sheet2")
    .Range("A1").PasteSpecial
    S2ER = .Range("O65536").End(xlUp).Row
    .Range("O2:O" & S2ER).Offset(, 1).Formula = "=COUNTIF(O$1:O2,O2)&""/""&O2"
    For i = S2ER To 2 Step -1
      .Rows(i).Copy
      .Rows(i).Resize(.Cells(i, "O").Value - 1).Insert
    Next
    S2ER = .Range("O65536").End(xlUp).Row
    .Range("O2:O" & S2ER).NumberFormatLocal = "@"
    .Range("O2:O" & S2ER).Offset(, 1).Copy
    .Range("O2").PasteSpecial (xlPasteValues)
    .Range("O2:O" & S2ER).Offset(, 1).Delete
    Application.Goto reference:=.Range("A1"), Scroll:=True
  End With
  Application.ScreenUpdating = True
  Application.CutCopyMode = False
End Sub

【22819】Re:Sheet1のデータをSheet2に条件をつけ...
発言  ichinose  - 05/3/4(金) 13:04 -

引用なし
パスワード
   ▼Sora さん:
こんにちは。
不具合の場合は、ExcelとWindowsのバージョンを記述して下さいね!!
どんなときに「型が一致しません」というエラーがでるのだろうか考えてみました。

Sheet1のO列に数字以外のデータが入っていた場合(例えば、"aaa")、
このエラーが発生します。
このO列は、1以上の整数が入っている事が条件です。

>皆さんに書いて頂いたことを参考にチャレンジしてみました。
>そのなかで、ichinoseさんから頂いたご回答について
>再度お伺いしたいことがありましたので、
>大変に申し訳ありませんがご教授頂ければと思います。
>
>お伺いしたいことについでですが…
>ichinoseさんのVBを実行してみたところ、
>結果としては満足できるように別シートに複写することができたのですが
>その途中で「型が一致しません」というメッセージが表示されてしまいました。
>デバックしたみたところ、下記の線で囲んでいるところが黄色くなり、
>そこを修正しなければいけないようです。
>
>ネットでいろいろと調べてみたのですが
>どうしても自力で解決できませんでしたので、
>もしこの件にお付き合い頂けるようでしたらご教授願えればと思います。
>
>
>Sub test()
  on error resume next
>  Dim sht1 As Worksheet
>  Set sht1 = Worksheets("sheet1")
>  odx = 2 'sheet2の書き込み行
>  For idx = 2 To sht1.Cells(sht1.Rows.Count, 1).End(xlUp).Row
>    '↑idxは、Sheet1の行
>   With Worksheets("sheet2")
>    repcnt = sht1.Range("o" & idx).Value
>    '↑繰り返し数の取得
>----------------------------------------------------------------------
>    .Range(.Cells(odx, 1), .Cells(odx + repcnt - 1, 14)).Value = _
>       sht1.Range(sht1.Cells(idx, 1), sht1.Cells(idx, 14)).Value
>----------------------------------------------------------------------
    if err.number<>0 then
     msgbox "Sheet1のカレント行: " & idx & vblf & _
         "Sheet2のカレント行: " & odx
     stop
     end if
>    'A列からN列はそのまま代入
>    s_add = .Range("o" & odx).Address
>    'sheet2のO列の書き込みセルの絶対アドレス
>    With .Range(.Cells(odx, 15), .Cells(odx + repcnt - 1, 15))
>     .NumberFormat = "0""/" & repcnt & """"
>     .Formula = "=(row()-row(" & s_add & ")+1)"
>     .Value = .Value
>     End With
>    odx = odx + repcnt
>    End With
>   Next idx
>End Sub

等としてエラーになっている行に正しくデータが入っているかを確認してみて下さい。

それでも駄目なら、
このエラーになっている行のセルの内容を書式なども合わせて記述してみて下さい。


この後の返信は、夜になってしまいますが・・・・。

【22838】間違えました。
回答  Jaka  - 05/3/4(金) 17:31 -

引用なし
パスワード
   訂正。

>    .Range("O2:O" & S2ER).Offset(, 1).Formula = "=COUNTIF(O$1:O2,O2)&""/""&O2"
      ↓

    .Range("O2:O" & S2ER).Offset(, 1).Formula = "=COUNTIF(N$1:N2,N2)&""/""&O2"

【22845】Re:Sheet1のデータをSheet2に条件をつけ...
お礼  Sora  - 05/3/4(金) 19:07 -

引用なし
パスワード
   ichinose様、その他の皆さま、いろいろと有り難うございました。

「型が一致しません」の件は、ichinose様がご指摘の通り
O列に数字ではなく、他のセルから数字を読むように
「=」の式をいれていました。

式を外し、数字のみにすることで無事解決しました。

いろいろと有り難うございました。

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