Snasui Excel Forum

Code: Select all

Dim fileToOpen
Dim rs As Range
Dim Mydata As Range
Dim MyFile As String
Dim sFile As String
Dim xFile As String
Dim r As Long
Dim FileSaveName As String
'On Error Resume Next
Sheet3.Range("BG1").Value = 0
frmload.Label2.Font = "Wingdings 2"
frmload.Label2.Caption = "X"
frmload.Label2.ForeColor = &H80000005
Sheet3.Range("A:AZ").ClearContents
Application.ScreenUpdating = False
With Workbooks("CIM.xlsm").Worksheets("Cimy")
Set rs = Workbooks("CIM.xlsm").Worksheets("Cimy").Range("A1")
Set Mydata = Workbooks("CIM.xlsm").Worksheets("Cimy").Range("A:AT")
End With
fileToOpen = Application.GetOpenFilename '( _
      FileFilter:="WorkbookMacro(
       '(*.xls),*xls,(*xlsx),*xlsx")
      MyFile = fileToOpen
 If fileToOpen = False Then
  MsgBox "โปรดเลือกไฟล์", vbOKOnly, "CIM 360"
 Exit Sub
 End If
   If fileToOpen <> False Then
 Workbooks.OpenText Filename:=MyFile
  Application.DisplayAlerts = False
   ActiveWorkbook.Worksheets(1).Columns("A:AT").Select
  Selection.Copy: rs.PasteSpecial xlPasteValues
   Application.CutCopyMode = False
 ActiveWorkbook.Close True
End If
Sheet3.Activate
Rows("1:1").Select
    Selection.Delete Shift:=xlUp
  Columns("Q:R").Select
    Selection.Delete Shift:=xlToLeft
Sheet3.Activate
Columns("R:T").Select
    Selection.Delete Shift:=xlToLeft
 Sheet1.Activate
   With Workbooks("CIM.xlsm").Worksheets("Cimy")
 r = 2
Do Until Sheet3.Cells(r, 2).Value = ""
 Sheet3.Cells(r, 42).Formula = "=VLOOKUP(" & Sheet3.Cells(r, 2).Address & ",Cimx!B:B,1,0)"
 Sheet3.Cells(r, 43).Formula = "=IFERROR(" & Sheet3.Cells(r, 42).Address & ",""X"" )"
  Sheet3.Cells(r, 1).Value = Sheet3.Cells(r, 43).Value
 r = r + 1
frmload.TextBox1.Value = r - 1
     DoEvents
Loop
    End With
    
 With Workbooks("CIM.xlsm").Worksheets("Cimy")
 r = 2
Do Until Sheet3.Cells(r, 1).Value = ""
  If Sheet3.Cells(r, 1).Value = "X" Then
           Sheet3.Cells(r, 1).EntireRow.Delete
       End If
 r = r + 1
frmload.TextBox1.Value = r - 1
     DoEvents
Loop
     
  End With

Code: Select all

'Other code
r = 2
Do Until Sheet3.Cells(r, 1).Value = ""
     If Sheet3.Cells(r, 1).Value = "X" Then
              Sheet3.Cells(r, 1) = ""
          End If
    r = r + 1
    frmload.TextBox1.Value = r - 1
    DoEvents
Loop
With Sheet3
    .Range("a2", .Range("a" & Rows.Count).End(xlUp)) _
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
'Other code