Form Import Data (1 người xem)

[keke355992]

Xin chào các AC trong diễn đàn!
E sưu tập được 1 file Import dữ liệu như đính kèm, trong file không có Form. E tạo 1 form, thể hiện các đường dẫn và nội dung tương tự như file. Nhưng chưa bít cách chèn code vào Form để nó hoạt động được. Mục đích của e là hiện các điều kiện tại Form để không pải chèn thêm 1 dòng bôi màu đen như trong File.

Mong sự giúp đỡ của các AC. E cảm ơn ạ

 

[giaiphap]

Bạn thêm chổ màu đỏ nè bạn.

Sub GetFile()
    'Dim the variables
    Dim FileSelect As Variant
    Dim wb As Workbook
    Dim i As Integer
    'on error statement
        On Error GoTo errHandler:
    'hold in memory
        Application.ScreenUpdating = False
    'locate the file path
        FileSelect = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*", _
    MultiSelect:=False)
    'check if a file is selected
    If FileSelect = False Then
    MsgBox "Select the file name"
    Exit Sub
    End If
    'send the path to the worksheet
[COLOR=#ff0000][B]UserForm1.TextBox1.Text = FileSelect[/B][/COLOR]
    Sheet1.Range("C4").Value = FileSelect
    'open the workbook
    Set wb = Workbooks.Open(FileSelect)
    'add the sheet names to the workbook
    Sheet1.Range("K4:K100").ClearContents
    For i = 1 To Sheets.Count
    Sheet1.Range("K" & i + 3) = Sheets(i).Name
[COLOR=#ff0000][B]UserForm1.ComboBox1.AddItem Sheets(i).Name[/B][/COLOR]
    Next i
    'close the workbook
    wb.Close False
    Application.ScreenUpdating = True
    Exit Sub
    'error block
errHandler:
    MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
    & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "Please notify the administrator"
End Sub

 

[keke355992]

E đã sửa được thêm 1 chút code nhưng hiện tại vẫn chưa hoạt động được. Nhờ các AC xem giúp e típ với ạ, E cảm ơn

Theo e thì hình như bị sai ở đoạn bôi đỏ có phải ko ạ

Public Sub GetRange()
'Dim variables
Dim FileSelect As Variant
Dim wb As Workbook
Dim Addme As Range, _
CopyData As Range, _
Bk As Range, _
Sh As Range, _
St As Range, _
Fn As Range, _
Tb As Range, _
c As Range
'on error statement
On Error GoTo errHandler:
'hold values in memory
Application.ScreenUpdating = False
'check neccessary cells have values
For Each c In Sheet1.Range("C4,F4:I4")
If c.Value = "" Then
MsgBox "You have left out a value that is needed in " & c.Address
Exit Sub
End If
Next c
'set the range reference variables
Set Bk = UserForm1.TextBox1.Value ' Sheet1.Range("C4") 'file path of book to import from
Set Sh = UserForm1.ComboBox2.Value ' Sheet1.Range("F4") 'sheet to import
Set St = UserForm1.TextBox3.Value ' Sheet1.Range("G4") 'starting cell reference
Set Fn = UserForm1.TextBox4.Value ' Sheet1.Range("H4") 'finishing cell reference
Set Tb = UserForm1.ComboBox1.Value ' Sheet1.Range("I4") 'sheet in this workbook to send it to
'set the destination
'Set Addme = Worksheets(Tb.Value).Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
Set Addme = Worksheets(Tb.Value).Range("C" & [J4])
'open the workbook
Set wb = Workbooks.Open(Bk)
'set the copy range
Set CopyData = Worksheets(Sh.Value).Range(St & ":" & Fn)
'copy and paste the data
CopyData.Copy
Addme.PasteSpecial xlPasteValues
'clear the clipboard
Application.CutCopyMode = False
'close the workbook
wb.Close False
'return to the interface sheet
Sheet1.Select
Application.ScreenUpdating = True
Exit Sub
'error block
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub

 

[keke355992]

Bạn thêm chổ màu đỏ nè bạn.

Sub GetFile()
    'Dim the variables
    Dim FileSelect As Variant
    Dim wb As Workbook
    Dim i As Integer
    'on error statement
        On Error GoTo errHandler:
    'hold in memory
        Application.ScreenUpdating = False
    'locate the file path
        FileSelect = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*", _
    MultiSelect:=False)
    'check if a file is selected
    If FileSelect = False Then
    MsgBox "Select the file name"
    Exit Sub
    End If
    'send the path to the worksheet
[COLOR=#ff0000][B]UserForm1.TextBox1.Text = FileSelect[/B][/COLOR]
    Sheet1.Range("C4").Value = FileSelect
    'open the workbook
    Set wb = Workbooks.Open(FileSelect)
    'add the sheet names to the workbook
    Sheet1.Range("K4:K100").ClearContents
    For i = 1 To Sheets.Count
    Sheet1.Range("K" & i + 3) = Sheets(i).Name
[COLOR=#ff0000][B]UserForm1.ComboBox1.AddItem Sheets(i).Name[/B][/COLOR]
    Next i
    'close the workbook
    wb.Close False
    Application.ScreenUpdating = True
    Exit Sub
    'error block
errHandler:
    MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
    & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "Please notify the administrator"
End Sub

Cảm ơn a. Nhờ A xem giúp e bài phía dưới với ạ

 

[giaiphap]

E đã sửa được thêm 1 chút code nhưng hiện tại vẫn chưa hoạt động được. Nhờ các AC xem giúp e típ với ạ, E cảm ơn

Theo e thì hình như bị sai ở đoạn bôi đỏ có phải ko ạ

Public Sub GetRange()
'Dim variables
Dim FileSelect As Variant
Dim wb As Workbook
Dim Addme As Range, _
CopyData As Range, _
Bk As Range, _
Sh As Range, _
St As Range, _
Fn As Range, _
Tb As Range, _
c As Range
'on error statement
On Error GoTo errHandler:
'hold values in memory
Application.ScreenUpdating = False
'check neccessary cells have values
For Each c In Sheet1.Range("C4,F4:I4")
If c.Value = "" Then
MsgBox "You have left out a value that is needed in " & c.Address
Exit Sub
End If
Next c
'set the range reference variables
Set Bk = UserForm1.TextBox1.Value ' Sheet1.Range("C4") 'file path of book to import from
Set Sh = UserForm1.ComboBox2.Value ' Sheet1.Range("F4") 'sheet to import
Set St = UserForm1.TextBox3.Value ' Sheet1.Range("G4") 'starting cell reference
Set Fn = UserForm1.TextBox4.Value ' Sheet1.Range("H4") 'finishing cell reference
Set Tb = UserForm1.ComboBox1.Value ' Sheet1.Range("I4") 'sheet in this workbook to send it to
'set the destination
'Set Addme = Worksheets(Tb.Value).Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
Set Addme = Worksheets(Tb.Value).Range("C" & [J4])
'open the workbook
Set wb = Workbooks.Open(Bk)
'set the copy range
Set CopyData = Worksheets(Sh.Value).Range(St & ":" & Fn)
'copy and paste the data
CopyData.Copy
Addme.PasteSpecial xlPasteValues
'clear the clipboard
Application.CutCopyMode = False
'close the workbook
wb.Close False
'return to the interface sheet
Sheet1.Select
Application.ScreenUpdating = True
Exit Sub
'error block
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub

Mình chỉ sửa cho code của bạn chạy thôi nghe, còn việc đúng mục đích bạn không mình không biết lý do không biết ý bạn muốn làm việc gì.
Bạn sửa code thế này.

Public Sub GetRange()
'Dim variables
Dim FileSelect As Variant
Dim wb As Workbook
Dim Addme As Range, _
CopyData As Range, _
Bk As String, _
Sh As String, _
St As String, _
Fn As String, _
Tb As String, _
c As Range
'on error statement
On Error GoTo errHandler:
'hold values in memory
Application.ScreenUpdating = False
'check neccessary cells have values
For Each c In Sheet1.Range("C4,F4:I4")
If c.Value = "" Then
MsgBox "You have left out a value that is needed in " & c.Address
Exit Sub
End If
Next c
'set the range reference variables
 Bk = UserForm1.TextBox1.Value    ' Sheet1.Range("C4") 'file path of book to import from
 Sh = UserForm1.ComboBox2.Value   ' Sheet1.Range("F4") 'sheet to import
 St = UserForm1.TextBox3.Value    ' Sheet1.Range("G4") 'starting cell reference
 Fn = UserForm1.TextBox4.Value    ' Sheet1.Range("H4") 'finishing cell reference
 Tb = UserForm1.ComboBox1.Value   ' Sheet1.Range("I4") 'sheet in this workbook to send it to
'set the destination
'Set Addme = Worksheets(Tb.Value).Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
Set Addme = Worksheets(Tb).Range("C" & [J4])
'open the workbook
Set wb = Workbooks.Open(Bk)
'set the copy range
Set CopyData = Worksheets(Sh).Range(St & ":" & Fn)
'copy and paste the data
CopyData.Copy
Addme.PasteSpecial xlPasteValues
'clear the clipboard
Application.CutCopyMode = False
'close the workbook
wb.Close False
'return to the interface sheet
Sheet1.Select
Application.ScreenUpdating = True
Exit Sub
'error block
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub

 

[keke355992]

Mình chỉ sửa cho code của bạn chạy thôi nghe, còn việc đúng mục đích bạn không mình không biết lý do không biết ý bạn muốn làm việc gì.
Bạn sửa code thế này.

Public Sub GetRange()
'Dim variables
Dim FileSelect As Variant
Dim wb As Workbook
Dim Addme As Range, _
CopyData As Range, _
Bk As String, _
Sh As String, _
St As String, _
Fn As String, _
Tb As String, _
c As Range
'on error statement
On Error GoTo errHandler:
'hold values in memory
Application.ScreenUpdating = False
'check neccessary cells have values
For Each c In Sheet1.Range("C4,F4:I4")
If c.Value = "" Then
MsgBox "You have left out a value that is needed in " & c.Address
Exit Sub
End If
Next c
'set the range reference variables
 Bk = UserForm1.TextBox1.Value    ' Sheet1.Range("C4") 'file path of book to import from
 Sh = UserForm1.ComboBox2.Value   ' Sheet1.Range("F4") 'sheet to import
 St = UserForm1.TextBox3.Value    ' Sheet1.Range("G4") 'starting cell reference
 Fn = UserForm1.TextBox4.Value    ' Sheet1.Range("H4") 'finishing cell reference
 Tb = UserForm1.ComboBox1.Value   ' Sheet1.Range("I4") 'sheet in this workbook to send it to
'set the destination
'Set Addme = Worksheets(Tb.Value).Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
Set Addme = Worksheets(Tb).Range("C" & [J4])
'open the workbook
Set wb = Workbooks.Open(Bk)
'set the copy range
Set CopyData = Worksheets(Sh).Range(St & ":" & Fn)
'copy and paste the data
CopyData.Copy
Addme.PasteSpecial xlPasteValues
'clear the clipboard
Application.CutCopyMode = False
'close the workbook
wb.Close False
'return to the interface sheet
Sheet1.Select
Application.ScreenUpdating = True
Exit Sub
'error block
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub

E cảm ơn. E đã chỉnh sửa đc code cho phù hợp với mình. Chúc a tuần mới hạnh phúc