Excel VBA質問箱 IV

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

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


57201 / 76732 ←次へ | 前へ→

【24269】Re:モビルスーツ工場
発言  ichinose  - 05/4/18(月) 11:09 -

引用なし
パスワード
   ▼ブライト さん:
こんにちは。

>はじめまして、ブライトといいます。
>質問させてください。
>自分に分かりやすい様に、ガンダムに登場するモビルスーツを生産する工場を例えています。
>
>Sheet1(計画)
>  A       B 
>ガンダム
>ザク
>ゲルググ
>
>Sheet2(変更)
>  A       B
>ガンダム    ガンキャノン
>ザク       ザク
>ゲルググ    ドム
>ガンキャノン  ガンタンク
>ガンタンク   ガンダム
>ガンダム    Zガンダム
>
>Sheet1に生産予定計画があります。
>今の段階ではガンダムとザクとゲルググが予定です。
>Sheet2は生産計画変更の一覧です。
>ガンダムで例えると…
>ガンダム⇒ガンキャノン⇒ガンタンク⇒ガンダム⇒Zガンダムと目まぐるしく予定変更になっています。最終的にはガンダムの予定がZガンダムを生産することになりました。
>ザクはザクのままです。
>ゲルググはドムに計画変更となりました。  
>結果をSheet1(計画)のB列に表示したいです。
>
>以上の事をVBAで行いたいのです。
>
>自分なりに考えた結果は
>Findnext
>For 〜 next
>DO 〜
>If 〜 then 〜else 〜 end if
>これらを使えば出来そうなのですが、どなたか教えていただけませんか?
では、これらを使用して・・・。

'============================================================
Sub main()
  Dim sht1rng As Range
  Dim sht2rng As Range
  Dim rng As Range
  Dim st As Long
  Dim result As Variant
  With Worksheets("sheet1")
   Set sht1rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
   End With
  With Worksheets("sheet2")
   Set sht2rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
   End With
  For Each rng In sht1rng
   st = 0
   result = rng.Value
   st = search_str(result, sht2rng, st + 1)
   Do Until st = 0
    result = sht2rng.Cells(st).Offset(0, 1).Value
    st = search_str(result, sht2rng, st + 1)
    Loop
   rng.Offset(0, 1).Value = result
   Next rng
End Sub
'=======================================================================
Function search_str(s_str As Variant, rng As Range, st As Long) As Long
  search_str = 0
  For idx = st To rng.Count
   If rng.Cells(idx).Value = s_str Then
    search_str = idx
    Exit For
    End If
   Next idx
End Function

データは、それぞれのシートの1行目A列から入っているとします。
つまり、例で挙げられたとおりということで・・・。

0 hits

【24268】モビルスーツ工場 ブライト 05/4/18(月) 10:26 質問
【24269】Re:モビルスーツ工場 ichinose 05/4/18(月) 11:09 発言
【24284】Re:モビルスーツ工場 Jaka 05/4/18(月) 17:06 質問
【24291】Re:モビルスーツ工場 G-Luck 05/4/18(月) 18:35 発言
【24292】Re:モビルスーツ工場 ブライト 05/4/18(月) 19:12 質問
【24294】Re:モビルスーツ工場 G-Luck 05/4/18(月) 19:28 発言
【24295】Re:モビルスーツ工場 ウッシ 05/4/18(月) 19:31 回答
【24309】Re:モビルスーツ工場 ブライト 05/4/19(火) 8:53 お礼

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