Results of 1 - 1 of about 37697 for IF (0.007 sec.)
- [[20210521231309]]
- #score: 1591
- @digest: a1f9693e97372f4c034754e78c1a09ea
- @id: 87764
- @mdate: 2021-05-23T01:59:12Z
- @size: 16397
- @type: text/plain
- #keywords: 先機 (87994), 前機 (83106), beforeb (79579), 種上 (66427), zwbexists (64497), fnmtx (61298), 位品 (52934), 入工 (45473), databk (44580), 機種 (42906), 種投 (42032), 種f (34297), 現機 (34278), leadb (33435), 番tm (29523), 名tm (23706), 種名 (23311), 種フ (22736), き先 (20924), idx (20556), 棚番 (20262), グ配 (13214), 投入 (12865), ャグ (9247), 種目 (8836), 上位 (7490), 書込 (6327), rr (5066), 工程 (4874), timer (4627), 隠居 (3729), tmp (3632)
- 『転記について』（u）
こんばんは 以前隠居じーさん様にご教授いただいたコードで コードの内容を自分なりに理解しようとしていますが 理解できずに困っています。 コードは Dim zTb As Workbook Dim i As Long Dim j As Long Dim k As Long Dim n As Long Dim v() As Variant Dim tMp() As Variant Dim iDx() As Variant Dim leadB As Workbook Dim beforeB As Workbook Dim x As Variant Dim fNmTx As String Dim fNmBk As String Dim dAtaBk As Variant Dim rr As Range Dim t As Double t = Timer Set zTb = Workbooks(zProgramID) With zTb.Worksheets("機種間共通検索") v = .Range("D1:YC154").Value End With For i = 2 To UBound(v, 2) Step 13 For j = 12 To UBound(v, 1) If v(j, i) <> "" Then ReDim tMp(1 To 3 + 2) tMp(1) = v(3, i - 1) tMp(2) = v(j, i) tMp(3) = v(j, i + 1) tMp(4) = v(7, i - 1) '先行機種 上位品番 tMp(5) = v(7, i) '先行機種 投入工程 ReDim Preserve iDx(n) iDx(n) = tMp n = n + 1 End If Next Next n = 0 For i = LBound(iDx) To UBound(iDx) fNmTx = ThisWorkbook.Path & "¥" & iDx(i)(2) & ".xlsx" If zWbExists(fNmTx) Then Set leadB = Workbooks.Open(fNmTx) With leadB.Worksheets(1) Set rr = .Range("B6:AJ359") For k = 2 To rr.Rows.Count If iDx(i)(4) = "" Then If rr(k, 1) = iDx(i)(3) And rr(k, 35) = iDx(i)(5) Then n = rr(k, 1).Row End If Else If rr(k, 1) = iDx(i)(3) And rr(k, 35) = iDx(i)(5) And rr(k, 30) = iDx(i)(4) Then n = rr(k, 1).Row End If End If Next If n > 0 Then If iDx(i)(1) <> "" Then .Cells(n, "A") = iDx(i)(1) fNmBk = iDx(i)(2) dAtaBk = .Cells(n, "F").Value End If n = 0 End With leadB.Close True Set rr = Nothing Set leadB = Nothing Else MsgBox "行き先機種F Non" & Chr(13) & iDx(i)(2) & ".xlsx" Exit For End If '前機種名 If iDx(i)(1) <> "" Then fNmTx = ThisWorkbook.Path & "¥" & iDx(i)(1) & ".xlsx" If zWbExists(fNmTx) Then Set beforeB = Workbooks.Open(fNmTx) With beforeB.Worksheets(1) x = Application.Match(iDx(i)(3), .Range("B:B"), 0) If Not IsError(x) Then If fNmBk <> "" Then .Cells(x, "H") = fNmBk fNmBk = "" End If If dAtaBk <> "" Then .Cells(x, "C") = dAtaBk dAtaBk = "" End If End If End With beforeB.Close True Set beforeB = Nothing Else MsgBox "前機種F Non" & Chr(13) & iDx(i)(1) & ".xlsx" Exit For End If End If If i Mod 30 = 0 Then DoEvents Next Set zTb = Nothing Erase v, iDx, tMp MsgBox "終了 " & Format(Int(Timer - t) / 24 / 60 / 60, "hh : mm : ss") & _ Format((Timer - t) - Int(Timer - t), ".000") & " 秒" End Sub Private Function zWbExists(ByVal fp As String) As Boolean zWbExists = False If Dir(fp) <> "" Then zWbExists = True End Function （隠居じーさん） 2021/04/08(木) 08:59 で 理解に苦しんでいるのは For k = 2 To rr.Rows.Count If iDx(i)(4) = "" Then If rr(k, 1) = iDx(i)(3) And rr(k, 30) = iDx(i)(5) Then n = rr(k, 1).Row End If Else If rr(k, 1) = iDx(i)(3) And rr(k, 30) = iDx(i)(5) And rr(k, 27) = iDx(i)(5) Then n = rr(k, 1).Row End If End If ここのコードの意味をご教授頂けると助かります。 ＜ 使用 Excel:Excel2010、使用 OS:Windows10 ＞ ---- 元ネタはこちらですね? [[20210320145513]] 隠居じーさん さんから詳しい説明があるまでのつなぎ。。です。 これは、多段配列または、、ジャグ配列といって ここで配列を配列しているのですね ReDim Preserve iDx(n) iDx(n) = tMp なので↓これは If iDx(i)(4) = "" Then iのこれですね。。。多分。。。 tMp(4) = v(7, i - 1) '先行機種 上位品番 （SoulMan） 2021/05/21(金) 23:32 ---- そうですね。 全てはそこから始まっています。 （u） 2021/05/21(金) 23:54 ---- おはようございます。。。^^ w SoulManさん、いつも済みません。有難う御座います。m(__)m いま、拝見致しました。 もう、すっかり、わたしの頭の中は空っぽで。これから記録探して読み返してみます。 ここ、一両日、予定が立て込んでいまして。。。←言い訳^^;よく精査してから←怪しい?(#^^#) アップしますね。て、いうか、SoulManさんのご説明以外の何物でもありませんので。。。 ＞＞これは、多段配列または、、ジャグ配列といって ＞＞ここで配列を配列しているのですね に基づいて、vba 多段配列、ジャグ配列とか検索でお調べいただくと参考サイトがたくさん御座います。 コード全体の流れは たしか、idxはファイル操作内容と、着色セルの行情報一覧表を作成し、着色するレンジの範囲とその配列 を用意して一覧表を基準に各処理をしていくような内容だったかと。。。 m(_ _)m （隠居じーさん） 2021/05/22(土) 08:31 ---- こんばんは ^^ iDx(i)の項目 現機種名 行き先機種名 棚番 行き先機種 上位品番 行き先機種 投入工程 変色行 変色列 For i = LBound(iDx) To UBound(iDx) 〜 '前機種名 の間では下記の様な事を処理しています。 1.行き先機種名のブックが有れば 2.行き先機種 上位品番が空なら、棚番が同じで且つ、投入工程が同じら書込み行nを取得 3.行き先機種 上位品番が有れば、棚番が同じで且つ、投入工程が同じで且つ、上位品番が同じなら、書込み行nを取得 4.書込み対象行がゼロでなければ 5.現機種名が空白で無ければ、書込みブックのA列n行目に現機種名を書込み 6.変数に行き先機種名を格納 7.変数に書込みブックのF列n行目の値を格納 8.行き先機種名のブックが無ければエラーMSGを出し終了処理 [[20210320145513]] 1 [[20210405211137]] 2 2のほうで、もこな2 さんがかなり掘り下げたご解説を 戴いていますので、是非ご参照ください。 以下は私が解りにくいなと自分でも思う項目です。 各説明サイト、VBA本等でご確認いただくと理解いただけるかと。。。 1.配列、[ジャグ配列] 2.範囲、に関して、全セルを対象としたセル、アドレス と、任意で指定した範囲のセルアドレスの指定の相違点 3.任意の範囲を配列に格納すれば同じ数値で、各セル番地と 二次元配列の要素を参照する添え字は同じものを使える[同じになる] 後書き 私のコーディングの癖といいますか、処理速度UPを意識し 配列を中心にロジックを勘案致しましたが、手元に処理情報が 有れば、配列に統一して書いたかもしれませんが、一部ピンポ イントで書込みをしたため、セル全体と任意の範囲、配列の三つ巴 となり、可読性の悪いコーディングになったかもしれません。 新規シートを追加の上、IDXのテキストダンプをとり対応一覧表を ご作成の上、コードと突き合わせると、解りやすいかもしれません。 m(_ _)m （隠居じーさん） 2021/05/22(土) 17:45 ---- ご対応ありがとうございます。 処理の順番や内容まで書いて頂き助かります。 前機種の方は 配列に入ったidx(3)棚番と開いたら前機種ファイルの棚番が一致したら処理を行うという人しでよろしいでしょうか? （u） 2021/05/22(土) 17:59 ---- ＞＞配列に入ったidx(3)棚番と開いたら前機種ファイルの棚番が一致 ＞＞したら処理を行うという人しでよろしいでしょうか? はい。。。そのようになっているかと。。。思います。m(_ _)m （隠居じーさん） 2021/05/22(土) 18:09 ---- こんばんは 前機種も行き先機種と同様の処理をしようとしています。 For i = LBound(iDx) To UBound(iDx) If iDx(i)(1) <> "" Then fNmTx = ThisWorkbook.Path & "¥出庫リスト¥" & iDx(i)(1) & ".xlsx" If zWbExists(fNmTx) Then Set beforeB = Workbooks.Open(fNmTx) With beforeB.Worksheets(1) Set rr = .Range("B6:AJ359") For k = 2 To rr.Rows.Count If iDx(i)(8) = "" Then If rr(k, 1) = iDx(i)(3) And rr(k, 30) = iDx(i)(9) Then n = rr(k, 1).Row End If Else If rr(k, 1) = iDx(i)(3) And rr(k, 30) = iDx(i)(9) And rr(k, 27) = iDx(i)(9) Then n = rr(k, 1).Row End If End If Next n = Application.Match(iDx(i)(3), .Range("B:B"), 0) If Not IsError(n) Then If .Cells(n, "H") = "" Then .Cells(n, "H") = iDx(i)(7) '空白なら書き込む 文字があったら何もしない .Cells(n, "H").EntireColumn.AutoFit dAtaBk = .Cells(n, "E").Value End If End With beforeB.Close True Set beforeB = Nothing Else MsgBox "前機種F Non" & Chr(13) & iDx(i)(1) & ".xlsx" Exit For End If End If 同ファイルの中にU1(1機種目)とU2(2機種目)が分かれていて、U1からU2の書き込みはうまくいきました。 しかし3機種目の別ファイルに書き込む際にU2と3機種目の共通部品の書き込みが上手くいきません。 上手くいかない場所は 前機種ファイル(U2)のH列に行き先機種名が書き込まれない 行き先ファイル(3機種目)のC列に前機種ファイルのE列の値を取得してくるはずだが、 なぜがU1でも共通部品があるのですがU1のE列の値を書き込んでいる どこがおかしいのでしょうか? 全体のコードも掲示します。 Application.ScreenUpdating = False Const zProgramID As String = "機種間共通部品,Z軸検索改良版??7.xlsm" Dim zTb As Workbook Dim i As Long Dim j As Long Dim k As Long Dim n As Long Dim v() As Variant Dim tMp() As Variant Dim iDx() As Variant Dim leadB As Workbook Dim beforeB As Workbook Dim x As Variant Dim fNmTx As String Dim fNmBk As String Dim dAtaBk As Variant Dim rr As Range Dim t As Double t = Timer Set zTb = Workbooks(zProgramID) With zTb.Worksheets("機種間共通部品検索") Set r = .Range("D1:ABW154") v = r.Value End With For i = 2 To UBound(v, 2) Step 15 For j = 11 To UBound(v, 1) If v(j, i) <> "" And r(j, i + 2).DisplayFormat.Interior.Color = 16777215 Then ReDim tMp(1 To 11) flgcnt = flgcnt + 1 tMp(1) = v(3, i + 1) '現ファイル名 tMp(2) = r(j, i + 2) '行き先ファイル名 tMp(3) = v(j, i + 3) '棚番 tMp(4) = v(j, i - 1) '行き先機種 上位品番 tMp(5) = v(j, i) '行き先機種 投入工程 tMp(6) = v(8, i + 1) '現機種名 tMp(7) = v(j, i + 1) '行き先機種名 tMp(8) = v(5, i + 1) '現機種 上位品番 tMp(9) = v(5, i + 2) '現機種 投入工程 tMp(10) = j tMp(11) = i + 2 ReDim Preserve iDx(n) iDx(n) = tMp n = n + 1 End If Next Next n = 0 '前機種 For i = LBound(iDx) To UBound(iDx) If iDx(i)(1) <> "" Then fNmTx = ThisWorkbook.Path & "¥出庫リスト¥" & iDx(i)(1) & ".xlsx" If zWbExists(fNmTx) Then Set beforeB = Workbooks.Open(fNmTx) With beforeB.Worksheets(1) Set rr = .Range("B6:AJ359") For k = 2 To rr.Rows.Count If iDx(i)(8) = "" Then If rr(k, 1) = iDx(i)(3) And rr(k, 30) = iDx(i)(9) Then n = rr(k, 1).Row End If Else If rr(k, 1) = iDx(i)(3) And rr(k, 30) = iDx(i)(9) And rr(k, 27) = iDx(i)(9) Then n = rr(k, 1).Row End If End If Next n = Application.Match(iDx(i)(3), .Range("B:B"), 0) If Not IsError(n) Then If .Cells(n, "H") = "" Then .Cells(n, "H") = iDx(i)(7) '空白なら書き込む 文字があったら何もしない .Cells(n, "H").EntireColumn.AutoFit dAtaBk = .Cells(n, "E").Value End If End With beforeB.Close True Set beforeB = Nothing Else MsgBox "前機種F Non" & Chr(13) & iDx(i)(1) & ".xlsx" Exit For End If End If '行き先機種名 fNmTx = ThisWorkbook.Path & "¥出庫リスト¥" & iDx(i)(2) & ".xlsx" If zWbExists(fNmTx) Then Set leadB = Workbooks.Open(fNmTx) r(iDx(i)(10), iDx(i)(11)).Interior.Color = vbYellow With leadB.Worksheets(1) Set rr = .Range("B6:AJ359") For k = 2 To rr.Rows.Count If iDx(i)(4) = "" Then If rr(k, 1) = iDx(i)(3) And rr(k, 30) = iDx(i)(5) Then n = rr(k, 1).Row End If Else If rr(k, 1) = iDx(i)(3) And rr(k, 30) = iDx(i)(5) And rr(k, 27) = iDx(i)(4) Then n = rr(k, 1).Row End If End If Next If n > 0 Then If iDx(i)(1) <> "" Then .Cells(n, "A") = iDx(i)(6) .Cells(n, "A").EntireColumn.AutoFit If .Cells(n, "C") = "" Then .Cells(n, "C") = dAtaBk dAtaBk = "" End If n = 0 End With leadB.Close True Set rr = Nothing Set leadB = Nothing Else MsgBox "行き先機種F Non" & Chr(13) & iDx(i)(2) & ".xlsx" Exit For End If If i Mod 30 = 0 Then DoEvents Next Set zTb = Nothing Erase v, iDx, tMp MsgBox "終了 " & Format(Int(Timer - t) / 24 / 60 / 60, "hh : mm : ss") & _ Format((Timer - t) - Int(Timer - t), ".000") & " 秒" End Sub Private Function zWbExists(ByVal fp As String) As Boolean zWbExists = False If Dir(fp) <> "" Then zWbExists = True End Function Private Sub CommandButton13_Click() Columns("C:YA").AutoFit End Sub （u） 2021/05/22(土) 23:56 ---- おはようございます ^^ 大分、元情報も、コードも。。。ご変更のよぉ〜で。。。そのぉ〜 私の理解をこえているよぉ〜ですので。一概には言えないのですが せっかく条件を改めて求めた書込み行nを もう一度、従来の棚番一致で求める行におきかわっているよぉ〜な気が するのですが。気のせいでしょうか。。。(#^.^#)v m(_ _)m （隠居じーさん） 2021/05/23(日) 06:54 ---- 朝早くに申し訳ありません。 おはよう御座います。 前機種上位品番idx(8).前機種投入工程idx(9)を追加しました。 これを、前機種のコード中追加して idx(3)の棚番と前機種上位品番idx(8)と前機種投入工程idx(9)と一致したら処理 を開始して、一致した行のh列に行先機種名を書き込み、e列の値を行き先機種の c列に書き込む処理をしようとしました。 （u） 2021/05/23(日) 10:16 ---- おはようございます ^^ n = Application.Match(iDx(i)(3), .Range("B:B"), 0) ↑ ここ。。。いらないのでは あと If Not IsError(n) Then nがゼロより大きければに変えるとか では。どうなるでしょうか。。。^^; ちょっと今から出かけます。。。頑張ってくださいね。 m(_ _)m （隠居じーさん） 2021/05/23(日) 10:59... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202105/20210521231309.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97059 documents and 608315 words.
訪問者：