Excel VBA質問箱 IV

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

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


106 / 74994 ←次へ | 前へ→

【80533】Re:処理が遅くなってしまう
発言  amatsuno  - 19/2/28(木) 14:05 -

引用なし
パスワード
   'ログ情報のうち、必要な列のみを抽出

  ws_master_csv.Columns(2).Copy
  ws_master_csv_new.Columns(5).PasteSpecial Paste:=xlPasteValues
 
  ws_master_csv.Columns(8).Copy ws_master_csv_new.Columns(2)
 
  ws_master_csv.Columns(18).Copy ws_master_csv_new.Columns(3)
  
  ws_master_csv.Columns(11).Copy
  ws_master_csv_new.Columns(4).PasteSpecial Paste:=xlPasteValues
  ws_master_csv_new.Columns(4).NumberFormatLocal = "h:mm:ss"
  
  ws_master_csv.Columns(7).Copy ws_master_csv_new.Columns(1)
  
        
 'グループ情報のうち、必要な列のみを抽出
 
  ws_group.Columns(1).Copy
  ws_group_new.Columns(1).PasteSpecial Paste:=xlPasteValues
 
  ws_group.Columns(5).Copy
  ws_group_new.Columns(2).PasteSpecial Paste:=xlPasteValues
    
  ws_group.Columns(2).Copy
  ws_group_new.Columns(3).PasteSpecial Paste:=xlPasteValues
  
      
 '表示名が空白のレコードに、端末機に紐付いている名称を入れる
  ws_master_csv_new.Columns(5).Copy
  ws_group_user.Columns(1).PasteSpecial Paste:=xlPasteValues
 
  ws_master_csv_new.Columns(1).Copy
  ws_group_user.Columns(2).PasteSpecial Paste:=xlPasteValues
    
  ws_master_csv.Columns(6).Copy
  ws_group_user.Columns(3).PasteSpecial Paste:=xlPasteValues
  
          
  Const cFormula As String = "=VLOOKUP(@,グループ情報更新!A:C,3,FALSE)"
  With Worksheets("名称補完")
    Worksheets("利用ユーザ").Range("A:C").Copy .Range("A:A")
    With .Range("A1").CurrentRegion.Columns(2)
      If Application.CountBlank(.Cells) > 0 Then
        With .SpecialCells(xlCellTypeBlanks)
        .Formula = Replace(cFormula, "@", .Cells(1).Offset(, -1).Address(False, False))
        End With
      .Value = .Value
      End If
    End With
   End With
          
   
  '名称を入れた表に、実行操作と所要時間を追加する
  ws_master_csv_new.Columns(3).Copy
  ws_cover.Columns(4).PasteSpecial Paste:=xlPasteValues
 
 
  ws_master_csv_new.Columns(4).Copy
  ws_cover.Columns(5).PasteSpecial Paste:=xlPasteValues
  ws_cover.Columns(5).NumberFormatLocal = "h:mm:ss"

  
  ws_cover.Columns(2).Copy ws_master_csv_new.Columns(1)


  ws_master_csv_new.Activate
  

'操作時間を抽出する
  Dim i4, LastRow As Long
  LastRow = Cells(Rows.Count, 1).End(xlUp).Row
  For i4 = 1 To LastRow
    If Cells(i4, 3) = "操作終了" Then
      Rows(i4).Copy ws_usetime.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End If
  Next i4


'各ユーザの操作の最も古い時刻と最も新しい時刻を出力結果に抽出する
  With ws_master_csv_new.Range("A2:D" & ws_master_csv_new.Cells(Rows.Count, 1).End(xlUp).Row)
    v = .Value
    For i = 1 To UBound(v)
      m = dic(v(i, 1))
      If m = 0 Then
        n = n + 1
        v(n, 1) = v(i, 1)
        v(n, 2) = v(i, 2)
        v(n, 3) = v(i, 2)
        dic(v(i, 1)) = n
      Else
        If v(m, 2) > v(i, 2) Then
          v(m, 2) = v(i, 2)
        End If
        If v(m, 3) < v(i, 2) Then
          v(m, 3) = v(i, 2)
        End If
      End If
    Next i
    ws_res.Cells(1, 1).Resize(n, .Columns.Count - 1) = v
    
  End With
  
  Set dic = Nothing


  ws_usetime.Columns(1).Copy
  ws_usetime_new.Columns(1).PasteSpecial Paste:=xlPasteValues
    
  ws_usetime.Columns(2).Copy
  ws_usetime_new.Columns(4).PasteSpecial Paste:=xlPasteValues

    
  ws_usetime.Columns(3).Copy
  ws_usetime_new.Columns(3).PasteSpecial Paste:=xlPasteValues
    
  ws_usetime.Columns(4).Copy
  ws_usetime_new.Columns(2).PasteSpecial Paste:=xlPasteValues
  ws_usetime_new.Columns(2).NumberFormatLocal = "h:mm:ss"
    
  ws_usetime.Columns(5).Copy
  ws_usetime_new.Columns(5).PasteSpecial Paste:=xlPasteValues
  
  
  ws_addtime.Activate

  
  '各ユーザーの利用時間を合算
 With Worksheets("開始終了更新")
   For i3 = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
     vK2 = .Cells(i3, "A").Value
     dic2(vK2) = dic2(vK2) + .Cells(i3, "B")
   Next
  End With

  ReDim vA3(1 To dic2.Count, 1 To 2)
  i3 = 0
  For Each vK2 In dic2.Keys
   i3 = i3 + 1
   vA3(i3, 1) = vK2
   vA3(i3, 2) = dic2(vK2)
  Next

  Application.ScreenUpdating = False
  With Worksheets("時間合計")
   With .Range("A1").Resize(i3, 2)
     .EntireColumn.ClearContents
     .Value = vA3
     .Columns(2).NumberFormatLocal = "h:mm:ss"
     Application.Goto .Cells(1), True
   End With
  End With
  Application.ScreenUpdating = True

  Rows(1).Insert


  Set dic2 = Nothing


   'ここで、マスタCSVから取得⇒配列にいれる列を指定


  ws_res.Columns(3).Copy
  ws_last.Columns(1).PasteSpecial Paste:=xlPasteValues
  ws_last.Columns(1).NumberFormatLocal = "yyyy/m/d"
  
  ws_res.Columns(1).Copy
  ws_last.Columns(3).PasteSpecial Paste:=xlPasteValues
  
  
  ws_res.Columns(2).Copy
  ws_last.Columns(4).PasteSpecial Paste:=xlPasteValues
  ws_last.Columns(4).NumberFormatLocal = "h:mm:ss"
  
  ws_res.Columns(3).Copy
  ws_last.Columns(5).PasteSpecial Paste:=xlPasteValues
  ws_last.Columns(5).NumberFormatLocal = "h:mm:ss"
 
  
  ws_addtime.Columns(2).Copy
  ws_last.Columns(6).PasteSpecial Paste:=xlPasteValues
  ws_last.Columns(6).NumberFormatLocal = "h:mm:ss"
  
  
  ws_addtime.Rows(1).Delete
   
  ws_last.Activate
 
  Rows(1).Insert

  Range("A1").Value = "日付"
  Range("B1").Value = "部署"
  Range("C1").Value = "エージェント"
  Range("D1").Value = "ON"
  Range("E1").Value = "OFF"
  Range("F1").Value = "稼働時間"


  ws_group_new.Columns(3).Copy
  ws_group_new_2.Columns(1).PasteSpecial Paste:=xlPasteValues
 
  
  ws_group_new.Columns(2).Copy
  ws_group_new_2.Columns(3).PasteSpecial Paste:=xlPasteValues
  
  
  ws_group_new.Columns(1).Copy
  ws_group_new_2.Columns(2).PasteSpecial Paste:=xlPasteValues
  
  ws_last.Columns(3).Copy
  ws_group_new_3.Columns(1).PasteSpecial Paste:=xlPasteValues
 
  
  ws_last.Columns(2).Copy
  ws_group_new_3.Columns(2).PasteSpecial Paste:=xlPasteValues
  
  
  ws_last.Columns(1).Copy
  ws_group_new_3.Columns(3).PasteSpecial Paste:=xlPasteValues


  Const cFormula2 As String = "=VLOOKUP(@,グループ補完2!A:C,3,FALSE)"
  With Worksheets("グループ名")
    Worksheets("グループ補完").Range("A:C").Copy .Range("A:A")
    With .Range("A1").CurrentRegion.Columns(2)
      If Application.CountBlank(.Cells) > 0 Then
        With .SpecialCells(xlCellTypeBlanks)
        .Formula = Replace(cFormula2, "@", .Cells(1).Offset(, -1).Address(False, False))
        End With
      .Value = .Value
      End If
    End With
   End With


  ws_group_name.Columns(2).Copy
  ws_last.Columns(2).PasteSpecial Paste:=xlPasteValues
  

   ws_last.Activate
  
  With Range("b2:b30000")
  .Replace what:="#N/A", replacement:="dummy", lookat:=xlWhole
  End With

    
'  ws_last.SaveAs "P:\fileexp.csv", FileFormat:=xlCSV, Local:=True


  '初期画面に戻る
  ws_btn.Activate
  
      
  Debug.Print Time
  
  '処理の終了
  Close #intFree
  Close #intFree2
  
  Call MsgBox("取り込みが完了しました。", vbSystemModal)
'  Application.DisplayAlerts = False 'メッセージを非表示設定に変更
'  Application.Quit
'  Workbooks.Close
'  Application.DisplayAlerts = True 'メッセージを表示設定に変更
    
End Sub

50 hits

【80532】処理が遅くなってしまう amatsuno 19/2/28(木) 14:04 質問[未読]
【80533】Re:処理が遅くなってしまう amatsuno 19/2/28(木) 14:05 発言[未読]
【80534】Re:処理が遅くなってしまう amatsuno 19/2/28(木) 14:12 発言[未読]
【80535】Re:処理が遅くなってしまう amatsuno 19/2/28(木) 14:18 発言[未読]
【80538】Re:処理が遅くなってしまう マナ 19/2/28(木) 18:54 発言[未読]
【80539】Re:処理が遅くなってしまう γ 19/2/28(木) 20:19 発言[未読]
【80541】Re:処理が遅くなってしまう amatsuno 19/3/1(金) 19:21 発言[未読]
【80542】Re:処理が遅くなってしまう amatsuno 19/3/1(金) 19:29 発言[未読]

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