Snasui Excel Forum

Code: Select all

Sub ImportExcelFile()
Dim sFilename As String
Dim rTarget As Range
Dim i As Integer, k As Integer
Application.ScreenUpdating = False
Sheets("รับข้อมูล").UsedRange.ClearContents
Set rTarget = Worksheets("รับข้อมูล").Range("A1")
sFilename = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , _
           "Select Excel Data File")
For i = 1 To Len(sFilename)
    If Mid(sFilename, i, 1) = "\" Then
        k = i + 1
    End If
Next i
If Mid(sFilename, k, 2) <> "20" Then
    MsgBox "This file can't import. Please check file name."
    Exit Sub
End If
Workbooks.Open Filename:=sFilename
Worksheets("Sheet1").UsedRange.Copy
rTarget.PasteSpecial xlPasteValues
Application.DisplayAlerts = False
ActiveWorkbook.Close
DeletRange
With Worksheets("รับเป้าหมาย")
    .Range("C4").Formula _
    = "=LOOKUP(9.99999999999999E+307,CHOOSE({1,2},0," & _
        "INDEX(รับข้อมูล!$B$2:$EF$500,MATCH(C$3,รับข้อมูล!$C$2:$C$500,0)," & _
        "MATCH($A4,รับข้อมูล!$B$2:$EF$2,0))))"
    .Range("C4").Copy .Range("C4:AF25")
End With
MsgBox "Finish"
Worksheets("รับเป้าหมาย").Activate
Application.ScreenUpdating = True
 End Sub

Sub DeletRange()
Dim i As Integer
With Worksheets("รับข้อมูล")
    For i = .Range("C65536").End(xlUp).Row To 1 Step -1
        If .Cells(i, "C") = "" Or .Cells(i, "C") = 0 Then
            .Cells(i, "C").EntireRow.Delete
        End If
    Next i
End With
End Sub

Code: Select all

Sub ShowUserForm()
    With UserForm1
        .LabelProgress.Width = 0
        .Left = Range("L10").Left
        .Top = Range("L10").Top
        .Show
    End With
End Sub

Code: Select all

Sub ImportExcelFile()
'...
With Worksheets("รับเป้าหมาย")
    .Range("C4").Formula _
    = "=LOOKUP(9.99999999999999E+307,CHOOSE({1,2},0," & _
        "INDEX(รับข้อมูล!$B$2:$EF$500,MATCH(C$2,รับข้อมูล!$B$2:$B$500,0)," & _
        "MATCH($A4,รับข้อมูล!$B$2:$EF$2,0))))"
    Call PasteData
End With
'...
 End Sub