[[20110715154032]]　『当てはまるNOの行を探し出して、それぞれのセルに』（煮干）　ページの最後に飛ぶ

『当てはまるNOの行を探し出して、それぞれのセルに文字を入力するマクロ』（煮干）

 Excel2003です。
 マクロについて質問させてください。

 A列にNO.1～NO.500ぐらいまでの文字が入っています（NO.によって5行あったり10行あったりします）
 やりたいのは、

 A1：変更したいNO
 A2：日付
 A3：状況（完了・調査・中止などを選ぶ）

 を入力してマクロを発動させると、適用するNOの行の文字が勝手に入力されるというものを作りたいです。

 　　A　　 B　　C　　D　　E　　F
 1　1　　 7/1  完了
 2
 3　NO.　品名　日付　状況
 4　1　　苺　　7/1　 完了
 5　1　　苺　　7/1　 完了
 6　1　　苺　　7/1　 完了
 7　2　　柿
 8　2　　柿
 9　3　　柘榴

 ↑分かりにくいですがこんな感じを希望しています。
 この表でいうと、C4～D6までが自動的に入力されて欲しいです。
 どなたか分かる方、お教え頂けるとうれしいです。
 お願いいたします。

 >A1：変更したいNO
 >A2：日付
 >A3：状況（完了・調査・中止などを選ぶ）

 これは、

 A1：変更したいNO
 B1：日付
 C1：状況（完了・調査・中止などを選ぶ）

 の間違い？

 ぶらっと立ち寄り

 A1：変更したいNO
 B1：日付
 C1：状況（完了・調査・中止などを選ぶ）

 こうだとして、たとえばシンプルに。

 Sub Sample()
    Dim c As Range
    With Sheets("Sheet1")
        For Each c In .Range("A4", .Range("A" & .Rows.Count).End(xlUp))
            If c.Value = .Range("A1").Value Then
                c.Offset(, 2).Resize(, 2).Value = .Range("B1:C1").Value
            End If
        Next
    End With
 End Sub

 ぶらっと立ち寄り

 お答えありがとうございます！

 ただ、文字の入力先をN：0列に替えようとして、
 c.Offset(, 13).Resize(, 2).Value = .Range("B1:C1").Value
 に変更すると、一気にマクロが重たくなってしまいます。
 軽くする方法はありますでしょうか？

 お分かりになる方、教えて頂けるとうれしいです。

 （煮干）

 確認１．
 　計算方法を手動にしてやってみる
 確認２．
 　ステップインで実行してみる
 確認３．
 　ご提示のデータとマクロのみを再度入力した新しいファイルでやってみる

 結果から原因が分かるかもしれません。

 (HANA)

 コードそのものは　Offsetをかえても、全く処理コストに影響がでないはず。
HANAさんが整理してくださり示唆されているように、
１．Ｃ，Ｄ列からＮ，Ｏ列にしたことで、Ｎ，Ｏ列の値を参照する（それもかなり重い）関数が存在するか。
２．Ｎ，Ｏ列のセルに対して、シートモジュールでChangeイベントコードがかかれているか。
３．シートが壊れているか。
４．ブックが壊れているか。
こんなことのほか、
５．モジュールシートそのものが壊れているか。
といったことが思いつく。
さらには（もしかしたら）このコード以外のロジックが追加で書かれていて、そことの相性のかねあいで足を引っ張っている。

 HANAさんからアドバイスあった方法で試してみてほしいのと、念のため、本当に動かしているコードを
コピペしてアップしてもらえれば、何か発見できるかも。

 ぶらっと立ち寄り

 かりに原因が、いままで想定している内のどれかだとして、その影響を極力排除するようなコード。一度試してみて。

 Sub SampleV()
    Dim v As Variant
    Dim i As Long
    Dim svCal As Long
    Dim svEvt As Boolean
    Dim myNum As Variant
    Dim myD As Variant, myS As Variant

    svCal = Application.Calculation
    svEvt = Application.EnableEvents

    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    With Sheets("Sheet1")
        myNum = .Range("A1").Value
        If Len(myNum) = 0 Then
            MsgBox "No が未入力です"
        Else
            v = .UsedRange.Offset(4).Value
            myD = .Range("B1").Value
            myS = .Range("C1").Value
            For i = 1 To UBound(v, 1)
                If v(i, 1) = myNum Then
                    v(i, 14) = myD
                    v(i, 15) = myS
                End If
            Next
            .Range("A4").Resize(UBound(v, 1), UBound(v, 2)).Value = v
        End If
    End With

    Application.EnableEvents = svEvt
    Application.Calculation = svCal

 End Sub

 ぶらっと立ち寄り

 お返事が遅くなりまして大変申し訳ございません。
 こちらのやりかたで試してみますね！
 何度もほんとうにありがとうございます！

（煮干）

コメント返信：

[ 一覧(最新更新順) ]

[[20110715154032]] 『当てはまるNOの行を探し出して、それぞれのセルに』（煮干） ページの最後に飛ぶ

[[20110715154032]]　『当てはまるNOの行を探し出して、それぞれのセルに』（煮干）　ページの最後に飛ぶ