Excel VBA質問箱 IV

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

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


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

【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 お礼[未読]

【24268】モビルスーツ工場
質問  ブライト  - 05/4/18(月) 10:26 -

引用なし
パスワード
   はじめまして、ブライトといいます。
質問させてください。
自分に分かりやすい様に、ガンダムに登場するモビルスーツを生産する工場を例えています。

Sheet1(計画)
  A       B 
ガンダム
ザク
ゲルググ

Sheet2(変更)
  A       B
ガンダム    ガンキャノン
ザク       ザク
ゲルググ    ドム
ガンキャノン  ガンタンク
ガンタンク   ガンダム
ガンダム    Zガンダム

Sheet1に生産予定計画があります。
今の段階ではガンダムとザクとゲルググが予定です。
Sheet2は生産計画変更の一覧です。
ガンダムで例えると…
ガンダム⇒ガンキャノン⇒ガンタンク⇒ガンダム⇒Zガンダムと目まぐるしく予定変更になっています。最終的にはガンダムの予定がZガンダムを生産することになりました。
ザクはザクのままです。
ゲルググはドムに計画変更となりました。  
結果をSheet1(計画)のB列に表示したいです。

以上の事をVBAで行いたいのです。

自分なりに考えた結果は
Findnext
For 〜 next
DO 〜
If 〜 then 〜else 〜 end if
これらを使えば出来そうなのですが、どなたか教えていただけませんか?

【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列から入っているとします。
つまり、例で挙げられたとおりということで・・・。

【24284】Re:モビルスーツ工場
質問  Jaka  - 05/4/18(月) 17:06 -

引用なし
パスワード
   ichinose さん ブライト さん
こんにちは。
かき回してみました。

Sub fidss()
  Dim SahR As Range, Cel As Range, FCL As Range, SavAd As String
  Dim SahSt As String
  Set SahR = Sheets("Sheet1").Range("A1", Sheets("Sheet1").Range("A65536").End(xlUp))
  With Sheets("Sheet2")
    For Each Cel In SahR
      SahSt = Cel.Value
      Set FCL = .Columns(1).Find(SahSt, After:=.Range("A65536"), LookAt:=xlWhole, MatchCase:=True)
      If Not FCL Is Nothing Then
        SavAd = FCL.Address
        Do
          SahSt = FCL.Offset(, 1).Value
          Set FCL = .Columns(1).Find(SahSt, After:=FCL, LookAt:=xlWhole, MatchCase:=True)
          If FCL Is Nothing Then Exit Do
        Loop Until FCL.Address = SavAd
        Cel.Offset(, 1).Value = SahSt
      End If
    Next
  End With
End Sub

【24291】Re:モビルスーツ工場
発言  G-Luck  - 05/4/18(月) 18:35 -

引用なし
パスワード
   ブライトさん、ichinoseさん、Jakaさん こんにちは

エラー処理をしていませんが、シンプルになるよう心がけてみました。

Sub test()
  
  Dim i As Integer
  Dim n As Integer
  Dim rg1 As Variant
  Dim rg2 As Variant
  
  rg1 = Worksheets("Sheet1").Cells(1).CurrentRegion.Value
  rg2 = Worksheets("Sheet2").Cells(1).CurrentRegion.Value
  
  For i = LBound(rg2, 1) To UBound(rg2, 1)
    n = 0
    On Error Resume Next
      n = WorksheetFunction.Match(rg2(i, 1), rg1, 0)
    On Error GoTo 0
    If n <> 0 Then
      rg1(n, 1) = rg2(i, 2)
    End If
  Next i
  Worksheets("Sheet1").Range("B1"). _
    Resize(UBound(rg1, 1), UBound(rg1, 2)) = rg1
End Sub

【24292】Re:モビルスーツ工場
質問  ブライト  - 05/4/18(月) 19:12 -

引用なし
パスワード
   みなさん、たくさんのレスありがとうございました。

ただ、ちょっと私では難しくて内容が理解できないものがあります。
G-Luckさんのものがシンプルそうなので、こちらで質問させて頂きます。

rg1,rg2,i,nの変数にはそれぞれどういった値が入るのですか?
また、On Error Resume Nextを使うとエラーが出なくなるそうなのですが、なぜこれを使わなくてはいけないのでしょうか?

的外れな質問をしてるかもしれませんが、解説を付けていただけると大変助かります。

お忙しい中すみませんが、よろしくお願いします。

【24294】Re:モビルスーツ工場
発言  G-Luck  - 05/4/18(月) 19:28 -

引用なし
パスワード
   ▼ブライト さん:

F8とローカルウィンドウを使うと、変化がよく分りますよ。
>rg1,rg2,i,nの変数にはそれぞれどういった値が入るのですか?

rg1 :生産予定計画
rg2 :生産計画変更の一覧
i  :生産計画変更を上から順に実行する為の変数です。
n  :Matchでrg1の上から何番目かが入ります

>また、On Error Resume Nextを使うとエラーが出なくなるそうなのですが、なぜこれを使わなくてはいけないのでしょうか?

生産計画変更の一覧の中に、生産予定計画に無い値が入っていた場合、
エラーが出てとまってしまうので、そうならないように付けています。

【24295】Re:モビルスーツ工場
回答  ウッシ  - 05/4/18(月) 19:31 -

引用なし
パスワード
   こんばんは

こんなのも、

Sub test()
  Dim r As Range
  Dim f As Range
  Dim s2 As Worksheet
  
  Set s2 = Worksheets("Sheet2")
  With Worksheets("Sheet1")
    For Each r In .Range("A1", .Range("A65536").End(xlUp))
      Set f = s2.Range("A1", s2.Range("A65536").End(xlUp)).Find( _
        r.Value, s2.Range("A1"), xlFormulas, xlWhole, , xlPrevious)
      If Not f Is Nothing Then
        r(1, 2).Value = f(1, 2).Value
      End If
    Next
  End With

End Sub

【24309】Re:モビルスーツ工場
お礼  ブライト  - 05/4/19(火) 8:53 -

引用なし
パスワード
   みなさんありがとうございました。

G-Luckさんのものを流用させて頂きます。

先週1週間悩んでいたものが、1日で解決したので感謝いたしております。

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