Excel VBA質問箱 IV

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

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


13790 / 76733 ←次へ | 前へ→

【68445】効率化UPお願いします。
質問  ののか  - 11/3/8(火) 17:16 -

引用なし
パスワード
   いつもお世話になってます。
自分なりに書いてみましたが、
処理に30分くらいかかってしまいます。
すみませんが宜しくお願いします。


Sub 品番走査数量書き込みプログラム()

 Dim MAIN As String    'Sheet1
 Dim REF As String    '参照用
 Dim KITEN As Range
 Dim C As Integer     '表MAIN最終行
 Dim HINBANM As String   'MAIN品番名
 Dim HINBANR As String   'REF品番名
 Dim A As Integer     'MAIN最終行
 Dim B As Integer     'REF最終行
 Dim M As Integer
 Dim R As Integer
 Dim FLAG As String
 Dim FLAG2 As String
 Dim GENKYOKU As String
 Dim GENKYOKU2 As String
 
 
 MAIN = "Sheet1"
 REF = "2006"
 
  '前ファイル最終行取得
  Set KITEN = Worksheets(MAIN).Range("A1")
  A = KITEN.CurrentRegion.Rows.Count
  
  '後ファイル最終行取得
  Set KITEN = Worksheets(REF).Range("A1")
  B = KITEN.CurrentRegion.Rows.Count
  

  For M = 2 To A           'MAIM品番
  
  HINBANM = Worksheets(MAIN).Cells(M, 4)
  GENKYOKU = Worksheets(MAIN).Cells(M, 1)
  
   R = 2              'REF品番
   Do While Len(Cells(R, 1)) > 0  'セルの文字数0ならば
  
   HINBANR = Worksheets(REF).Cells(R, 6)
   GENKYOKU2 = Worksheets(REF).Cells(R, 1)
    
  
   FLAG = StrComp(HINBANB, HINBANA, vbTextCompare)
   FLAG2 = StrComp(GENKYOKU, GENKYOKU2, vbTextCompare)
  
  
    If FLAG = 0 Then '一致していれば
    If FLAG2 = 0 Then
    Worksheets(MAIN).Cells(M, 10) = Worksheets(REF).Cells(R, 15)
    Worksheets(REF).Select   '該当行のカット
    Range(Cells(R, 2), Cells(R, 4)).EntireRow.Delete
    R = R + 1
   
    Else
    R = R + 1
   
    End If
    End If
   
    Loop
  
  Next M


End Sub
1 hits

【68445】効率化UPお願いします。 ののか 11/3/8(火) 17:16 質問
【68447】Re:効率化UPお願いします。 kanabun 11/3/8(火) 17:26 発言
【68448】Re:効率化UPお願いします。 ののか 11/3/8(火) 17:31 質問
【68449】Re:効率化UPお願いします。 kanabun 11/3/8(火) 17:36 発言
【68451】Re:効率化UPお願いします。 kanabun 11/3/8(火) 18:40 発言
【68452】Re:効率化UPお願いします。 kanabun 11/3/8(火) 19:54 質問
【68454】Re:効率化UPお願いします。 ののか 11/3/9(水) 8:58 発言
【68455】Re:効率化UPお願いします。 kanabun 11/3/9(水) 9:44 発言
【68456】Re:効率化UPお願いします。 ののか 11/3/9(水) 9:55 お礼
【68453】Re:効率化UPお願いします。 kanabun 11/3/8(火) 20:04 質問
【68457】Re:効率化UPお願いします。 ののか 11/3/9(水) 10:21 質問
【68458】Re:効率化UPお願いします。 kanabun 11/3/9(水) 10:46 発言
【68459】Re:効率化UPお願いします。 ののか 11/3/9(水) 10:55 お礼

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