Nhập dữ liệu từ Form vào file Data (2 người xem)

[hongtu1803]

Nhờ mọi người giúp.
Tôi đã làm được cái Form nhập dữ liệu trong file Form:
- Nhập dữ liệu vào FormPX -> Save dữ liệu vào PX.
Giờ tôi muốn nâng cấp lên một tí: dữ liệu sẽ được lưu vào file khác.
file "Data" lưu trên máy chủ; file "Form" lưu trên máy khác.
- Nhập dữ liệu vào FormPX [file Form]
- Nhấn nút "Save" dữ liệu vào PX [file Data]
Mục đích: để cùng lúc nhập dữ liệu trên hai máy khác nhau.
Cảm ơn mọi người đã giúp đỡ.

 

[hongtu1803]

Nhờ mọi người giúp.
Tôi đã làm được cái Form nhập dữ liệu trong file Form:
- Nhập dữ liệu vào FormPX -> Save dữ liệu vào PX.
Giờ tôi muốn nâng cấp lên một tí: dữ liệu sẽ được lưu vào file khác.
file "Data" lưu trên máy chủ; file "Form" lưu trên máy khác.
- Nhập dữ liệu vào FormPX [file Form]
- Nhấn nút "Save" dữ liệu vào PX [file Data]
Mục đích: để cùng lúc nhập dữ liệu trên hai máy khác nhau.
Cảm ơn mọi người đã giúp đỡ.

Nhờ mọi người giúp mình.

 

[hongtu1803]

Có ai giúp mình hay gợii ít topic liên quan.

 

[hongtu1803]

Vấn đề này không phải không làm được...Nhưng tại sao không ai giúp...Vì dấn thân vào giúp bạn rồi...thì khổ lắm
---------------------------
Cho nên: Bạn cần 1 lời khuyên...Tại sao không lắng nghe lời khuyên ấy...

Lời khuyên: Tại # cuối cùng trong topic này của bạn, bạn chưa lưu tâm: http://www.giaiphapexcel.com/forum/showthread.php?112401-Sửa-giùm-code-tạo-Form-nhập-liệu/page2

Xem xong, bạn cần lưu tâm + phản hồi thì sẽ có người tiếp. Bằng không thì...tự chơi 1 mình nhé!

À. Minh nhớ ra rồi. Phương án đó không thực hiện được, vì liên quan đến Form nhập dữ liệu.
Ví dụ:
Khi A nhập dữ liệu trên máy mình (file Form) thì lưu ngay lập tức vào file Data
Khi B nhập dữ liệu trên máy mình (file Form) thì lưu vào dòng kế tiếp tại file Data.
Cảm ơn bạn đã nhắc nhở & quan tâm.

 

[hongtu1803]

Theo ý tôi đã nói ở trên. Bạn cho mỗi nhân viên 1 File Form nhập liệu. Sau đó gôm File lại, và bạn thực hiện tổng hợp lên File Tổng (Data) của bạn
-----------------------------------------------------------------------------------------------------------------------------------
Cod như sau:
1. Code cho nút Save của File Form.xls (code thay cho cái Sub trong file của bạn.)

Public Sub NhapDuLieu()
Dim Arr, dArr, I As Long, J As Long, K As Long
Arr = Sheets("FormPX").Range("A6", Sheets("FormPX").Range("A9").End(4)).Resize(, 11).Value
ReDim dArr(1 To UBound(Arr), 1 To 12)
For I = 5 To UBound(Arr)
    If Arr(I, 1) <> Empty Then
        K = K + 1
        dArr(K, 1) = Arr(1, 8)
        dArr(K, 2) = Arr(I, 1)
        dArr(K, 3) = Arr(2, 8)
        For J = 2 To 8
            dArr(K, J + 2) = Arr(I, J)
        Next J
        dArr(K, 11) = Arr(2, 2)
        dArr(K, 12) = Arr(1, 2)
    End If
Next I
If K Then Sheets("PX").Range("A65000").End(3).Offset(1).Resize(K, 12).Value = dArr
End Sub

2. Code tổng hợp từ nhiều file cho File Data của bạn.

Đưa tất cả các file con (File Form cho từng người vào 1 thư mục, File Data cũng có thể đưa vào đây luôn, hoặc để ở đâu thì tùy.)

Chạy code -> Cửa sổ mở ra. Chọn cả Thư mục chứa file con trên -> Ok đợi kết quả sẽ update tất cả vào Sheet PX trên file Data này. (Chú ý là chọn Thư mục rồi nhấn OK , chứ không phải Open thư mục chứa file con ở cửa sổ chọn file nha.)

Public Sub THOP_ALL()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ChonO As Object, ChonF As Object, pFile, Path
Dim fil As Object, Wb As Workbook, Sh As Worksheet, WbMain As Workbook
Dim Arr, dArr(1 To 65000, 1 To 12), I As Long, J As Long, K As Long
pFile = ActiveWorkbook.Name
Set WbMain = ActiveWorkbook
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "CHON FOLDER"
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
    Path = .SelectedItems(1) & "\"
End With
Set ChonO = CreateObject("Scripting.FileSystemObject")
Set ChonF = ChonO.GetFolder(Path)
For Each fil In ChonF.Files
    If InStr(1, fil.Name, pFile) <= 0 Then
        Set Wb = Workbooks.Open(fil.Path)
        Set Sh = Wb.Sheets("PX")
            Arr = Sh.Range("A6", Sh.[A65000].End(3)).Resize(, 12).Value
            For I = 1 To UBound(Arr)
                K = K + 1
                For J = 1 To 12
                    dArr(K, J) = Arr(I, J)
                Next J
            Next I
        Workbooks(fil.Name).Close
    End If
Next fil
    WbMain.Sheets("PX").Range("A6").Resize(65000, 12).ClearContents
    WbMain.Sheets("PX").Range("A6").Resize(K, 12).Value = dArr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Cảm ơn bạn.
Phương án bạn chia sẻ mình đã hiểu, nhưng mình hơi cầu toàn một chút (tự động hết).
Ví dụ: Form trên File1, Data trên File2.
Mình muốn mở Form rồi lưu thẳng vào Data. Trên diễn đàn thấy có dùng ADO để lấy dữ liệu từ file khác (mở hoặc đóng, lưu cùng thư mục), nhưng mình thì muốn ngược lại, muốn lưu dữ liệu vào file khác (có trên máy khác trong LAN).
Cái vụ VBA đơn giản thì mình vọc được, chứ cái ADO thấy hay lắm nhưng chẳng biết sửa.
Có vẻ mình hơi "cố thủ" quan điểm, mong bạn thông cảm (vì quá cầu toàn).

 

[doveandrose]

À. Minh nhớ ra rồi. Phương án đó không thực hiện được, vì liên quan đến Form nhập dữ liệu.
Ví dụ:
Khi A nhập dữ liệu trên máy mình (file Form) thì lưu ngay lập tức vào file Data
Khi B nhập dữ liệu trên máy mình (file Form) thì lưu vào dòng kế tiếp tại file Data.
Cảm ơn bạn đã nhắc nhở & quan tâm.

Còn cách khác nữa là liên hệ với người này

Nguyễn Duy Tuân

để được sử dụng A-Tool . đáp ứng mọi nhu cầu của bạn .

 

[Kiều Mạnh]

Có ai giúp mình hay gợii ít topic liên quan.

Bạn có thể tham khảo thêm ở đây ....
Vì Nổi hứng với ADO và mê code két mà 3 đêm tui quên ngủ ngày quên ăn ...

lâu lâu cái bụng nó keo tui mở tủ lạnh xử mấy cái bánh trưng + bánh ngọt còn lại của ngày xuân để chế tác nên một cái khác biệt của riêng Mình

http://www.giaiphapexcel.com/forum/...u-File-Trong-Folder-Và-Update-File-Lên-Server

 

[hongtu1803]

Vậy thì chỉ cần như vậy thôi. Bằng VBA, ADO thì tôi không rành.

Code nút Save của bạn...
P/s: Cái đoạn màu đỏ chính là dường dẫn chứa file Data của bạn. Nếu ở trên sever thì bạn cần khai cho đúng dường dẫn & tất nhiên file này phải được Share Full nếu share qua Lan.

Với đoạn code tôi viết bên dứoi thì File Data của bạn phải để cùng Folder với File Form chạy code này...Chắc bạn hiểu!

Public Sub NhapDuLieu()
Dim fName As String, Wb As Workbook, Sh As Worksheet
Dim Arr, dArr, I As Long, J As Long, K As Long
Application.ScreenUpdating = False
Arr = Sheets("FormPX").Range("A6", Sheets("FormPX").Range("A9").End(4)).Resize(, 11).Value
ReDim dArr(1 To UBound(Arr), 1 To 12)
For I = 5 To UBound(Arr)
    If Arr(I, 1) <> Empty Then
        K = K + 1
        dArr(K, 1) = Arr(1, 8)
        dArr(K, 2) = Arr(I, 1)
        dArr(K, 3) = Arr(2, 8)
        For J = 2 To 8
            dArr(K, J + 2) = Arr(I, J)
        Next J
        dArr(K, 11) = Arr(2, 2)
        dArr(K, 12) = Arr(1, 2)
    End If
Next I
fName = [SIZE=4][COLOR=#ff0000][B]ThisWorkbook.Path & "\" & "Data.xls"[/B][/COLOR][/SIZE]
Set Wb = Application.Workbooks.Open(fName)
Set Sh = Wb.Worksheets("PX")
    If K Then Sh.Range("A65000").End(3).Offset(1).Resize(K, 12).Value = dArr
Wb.Close True
Application.ScreenUpdating = True
End Sub

----------------------
Ví dụ tôi có 1 Sever và File Data.xls của bạn đã được Share Full (cụ thể là Foder chứa file Data.xls này phải để ở chế độ Share Full) thì khai báo dường dẫn trên là:

fName = "\\192.168.1.8\LuuDuLieu\Data.xls"

1. Server có IP là 192.168.1.8 / Hoặc nếu không xài IP thì có thể thay bằng Tên của máy Server cũng được.
2. Folder được Share Full là LuuDuLieu
3. File Excel cần nhận dữ liệu là Data.xls

Chắc tới đây bạn đã hiểu & ứng dụng cho mình được!

Code vậy chuẩn rồi, đúng ý mình.
Cảm ơn bạn nhiều.
Có 2 vấn đề nhỏ nữa, bạn giúp sửa code giùm:
- Khi chạy code, file Data đang mở thì bị đóng -> mình muốn, nếu Data đang mở thì cứ để nguyên (không đóng).
- Khắc phục hạn chế "phải lưu 2 file cùng thư mục", mình tính sẽ đánh đường dẫn vào L1 sheet FormPX -> code tự động lưu theo đường dẫn này được không (như file đính kèm)?
Nhờ bạn giúp.

 

[hongtu1803]

Public Sub NhapDuLieu1()
Dim fName As String, Wb As Workbook, Sh As Worksheet
Dim Arr, dArr, I As Long, J As Long, K As Long
Application.ScreenUpdating = False
Arr = Sheets("FormPX").Range("A6", Sheets("FormPX").Range("A9").End(4)).Resize(, 11).Value
ReDim dArr(1 To UBound(Arr), 1 To 12)
For I = 5 To UBound(Arr)
    If Arr(I, 1) <> Empty Then
        K = K + 1
        dArr(K, 1) = Arr(1, 8)
        dArr(K, 2) = Arr(I, 1)
        dArr(K, 3) = Arr(2, 8)
        For J = 2 To 8
            dArr(K, J + 2) = Arr(I, J)
        Next J
        dArr(K, 11) = Arr(2, 2)
        dArr(K, 12) = Arr(1, 2)
    End If
Next I
fName = Sheets("FormPX").Range("L1").Value 'ThisWorkbook.Path & "\" & "Data.xls"
If Not IsFileOpen(fName) Then
Set Wb = Application.Workbooks.Open(fName)
Set Sh = Wb.Worksheets("PX")
    If K Then Sh.Range("A65000").End(3).Offset(1).Resize(K, 12).Value = dArr
    Wb.Close True
Else
    If K Then Workbooks("Data.xls").Sheets("PX").Range("A65000").End(3).Offset(1).Resize(K, 12).Value = dArr
End If
Application.ScreenUpdating = True
End Sub


Function IsFileOpen(FileName As String) As Boolean
Dim fso As Object
On Error Resume Next
Application.Volatile
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.MoveFile FileName, FileName
    IsFileOpen = (Err.Number <> 0)
End Function

Code ok rồi.
Cảm ơn nhiều. Hi vọng code cũng giúp cho nhiều người.

 

[hongtu1803]

Chỉ giúp cho mình bạn trước đã mà thấy mệt zồi đó...chứ nhiều người chi không biết!
------------------------------------------

Vậy bây chừ cho tôi hỏi lại 1 điều rằng... Phương án đó giờ có thực hiện được không? hay phải cần đến Form cao siêu, ADO khủng khiếp nhỉ???

Cho nên: Ở GPE này, đừng vội phán cái gì khi ta chưa chắc chắn, hoặc ta chưa biết nhé!

Khi chạy, nếu file Data mở, nó báo lỗi thế này: Rum - time error '9'
Vậy là sao hả bạn?
Public Sub NhapDuLieu3()
Dim fName As String, Wb As Workbook, Sh As Worksheet
Dim Arr, dArr, I As Long, J As Long, K As Long
Application.ScreenUpdating = False
Arr = Sheets("FormPX").Range("A6", Sheets("FormPX").Range("A9").End(4)).Resize(, 11).Value
ReDim dArr(1 To UBound(Arr), 1 To 12)
For I = 5 To UBound(Arr)
If Arr(I, 1) <> Empty Then
K = K + 1
dArr(K, 1) = Arr(1, 8)
dArr(K, 2) = Arr(I, 1)
dArr(K, 3) = Arr(2, 8)
For J = 2 To 8
dArr(K, J + 2) = Arr(I, J)
Next J
dArr(K, 11) = Arr(2, 2)
dArr(K, 12) = Arr(1, 2)
End If
Next I
fName = Sheets("FormPX").Range("L1").Value 'ThisWorkbook.Path & "" & "Data.xls"
If Not IsFileOpen(fName) Then
Set Wb = Application.Workbooks.Open(fName)
Set Sh = Wb.Worksheets("PX")
If K Then Sh.Range("A65000").End(3).Offset(1).Resize(K, 12).Value = dArr
Wb.Close True
Else
If K Then Workbooks("Data.xls").Sheets("PX").Range("A65000").End(3).Offset(1).Resize(K, 12).Value = dArr
End If
Application.ScreenUpdating = True
End Sub




Function IsFileOpen(FileName As String) As Boolean
Dim fso As Object
On Error Resume Next
Application.Volatile
Set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile FileName, FileName
IsFileOpen = (Err.Number <> 0)
End Function

 

[vubinh099]

Vậy thì chỉ cần như vậy thôi. Bằng VBA, ADO thì tôi không rành.

Code nút Save của bạn...
P/s: Cái đoạn màu đỏ chính là dường dẫn chứa file Data của bạn. Nếu ở trên sever thì bạn cần khai cho đúng dường dẫn & tất nhiên file này phải được Share Full nếu share qua Lan.

Với đoạn code tôi viết bên dứoi thì File Data của bạn phải để cùng Folder với File Form chạy code này...Chắc bạn hiểu!

Public Sub NhapDuLieu()
Dim fName As String, Wb As Workbook, Sh As Worksheet
Dim Arr, dArr, I As Long, J As Long, K As Long
Application.ScreenUpdating = False
Arr = Sheets("FormPX").Range("A6", Sheets("FormPX").Range("A9").End(4)).Resize(, 11).Value
ReDim dArr(1 To UBound(Arr), 1 To 12)
For I = 5 To UBound(Arr)
    If Arr(I, 1) <> Empty Then
        K = K + 1
        dArr(K, 1) = Arr(1, 8)
        dArr(K, 2) = Arr(I, 1)
        dArr(K, 3) = Arr(2, 8)
        For J = 2 To 8
            dArr(K, J + 2) = Arr(I, J)
        Next J
        dArr(K, 11) = Arr(2, 2)
        dArr(K, 12) = Arr(1, 2)
    End If
Next I
fName = [SIZE=4][COLOR=#ff0000][B]ThisWorkbook.Path & "\" & "Data.xls"[/B][/COLOR][/SIZE]
Set Wb = Application.Workbooks.Open(fName)
Set Sh = Wb.Worksheets("PX")
    If K Then Sh.Range("A65000").End(3).Offset(1).Resize(K, 12).Value = dArr
Wb.Close True
Application.ScreenUpdating = True
End Sub

----------------------
Ví dụ tôi có 1 Sever và File Data.xls của bạn đã được Share Full (cụ thể là Foder chứa file Data.xls này phải để ở chế độ Share Full) thì khai báo dường dẫn trên là:

fName = "\\192.168.1.8\LuuDuLieu\Data.xls"

1. Server có IP là 192.168.1.8 / Hoặc nếu không xài IP thì có thể thay bằng Tên của máy Server cũng được.
2. Folder được Share Full là LuuDuLieu
3. File Excel cần nhận dữ liệu là Data.xls

Chắc tới đây bạn đã hiểu & ứng dụng cho mình được!

Hi bạn,
Bạn có thể giải thích cho mình đoạn này được không. Cám ơn bạn!

Arr = Sheets("FormPX").Range("A6", Sheets("FormPX").Range("A9").End(4)).Resize(, 11).Value
ReDim dArr(1 To UBound(Arr), 1 To 12)
For I = 5 To UBound(Arr)
If Arr(I, 1) <> Empty Then
K = K + 1
dArr(K, 1) = Arr(1, 8)
dArr(K, 2) = Arr(I, 1)
dArr(K, 3) = Arr(2, 8)
For J = 2 To 8
dArr(K, J + 2) = Arr(I, J)
Next J
dArr(K, 11) = Arr(2, 2)
dArr(K, 12) = Arr(1, 2)
End If
Next I

 

[SA_DQ]

Arr = Sheets("FormPX").Range("A6", Sheets("FormPX").Range("A9").End(4)).Resize(, 11).Value
'Nạp dữ liệu từ vùng đã chọn vô mảng (nguồn)  '
ReDim dArr(1 To UBound(Arr), 1 To 12) ' Khai báo 1 mảng (đích) để chứa dữ liệu thỏa điều kiện  '
For I = 5 To UBound(Arr)   ' Duyệt các fần tử trong mảng (nguồn) từ dòng thứ 5  '
If Arr(I, 1) <> Empty Then   'Điều kiện: Nếu fần tử đầu của dòng mảng đang duyệt không trống (trơn)  '
K = K + 1  'Công/Thêm biến đếm 1 đơn vị  '
dArr(K, 1) = Arr(1, 8)    'Lấy fần tử thứ 8 của dòng mảng đang duyệt gán vô f ần tử đầu tiên của dòng vừa thêm thuộc mảng (đích) '
dArr(K, 2) = Arr(I, 1)    ' Tương tự, FT đích thứ 2 của dòng (đích) được gán từ fần tử 1 của mảng (nguồn)  '
dArr(K, 3) = Arr(2, 8)   'FT 3 của dòng đích được gán bỡi FT 8 thuộc dòng 2 của mảng (nguồn) ???  '
For J = 2 To 8   ' Vòng lặp từ 2 đến 8 để gán cho các FT 4 đến 10 của mảng đích từ FT thứ 2 đến thứ 8 của dòng đang duyệt của mảng (nguồn) '
dArr(K, J + 2) = Arr(I, J)
Next J
dArr(K, 11) = Arr(2, 2)  'Tiếp tục gán cho 2 FT còn lại cho mảng (đích)
dArr(K, 12) = Arr(1, 2) ' Xem dòng trên  '
End If  'Kết thúc điều kiện'
Next I  'Kết thúc vòng lặp  '

Những mong giúp được bạn tẹo nào đó, mình mừng.