Cập nhật dữ liệu tự động (2 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
N

nbphong2019

Thành viên mới
Tham gia
18/1/19
Bài viết
7
Được thích
1
Chào các bạn!
Mình có 2 file excel: file 1 (bảng điểm cập nhật)chứa dữ liệu điểm của sinh viên thi lại; file 2 (HUNRE.KNM)chứa dữ liệu điểm của sinh viên thi lần 1, và cả sinh viên thi lại nhưng chưa có điểm
Mình muốn cập nhật tự động điểm của sinh viên thi lại file 1 vào file 2, vẫn giữ nguyên điểm của sinh viên thi lần 1
Diễn dàn giúp mình cách làm nhé. Thanks
 

File đính kèm

nbphong2019 đã viết:
Chào các bạn!
Mình có 2 file excel: file 1 (bảng điểm cập nhật)chứa dữ liệu điểm của sinh viên thi lại; file 2 (HUNRE.KNM)chứa dữ liệu điểm của sinh viên thi lần 1, và cả sinh viên thi lại nhưng chưa có điểm
Mình muốn cập nhật tự động điểm của sinh viên thi lại file 1 vào file 2, vẫn giữ nguyên điểm của sinh viên thi lần 1
Diễn dàn giúp mình cách làm nhé. Cảm ơn
Nhấp chuột vào đây để mở rộng...
Bạn nói rõ xem nào.Vẫn giữ nguyên điểm lần 1 là sao.Mà sao không để trên cùng 1 file cập nhập cho rễ cần gì phải 2 file làm gì.
 
snow25 đã viết:
Bạn nói rõ xem nào.Vẫn giữ nguyên điểm lần 1 là sao.Mà sao không để trên cùng 1 file cập nhập cho rễ cần gì phải 2 file làm gì.
Nhấp chuột vào đây để mở rộng...
Khi thi lần 1, một số bạn trượt phải thi lần 2. Thi xong phải cập nhật điểm vào với các bạn thi lần 1, sau đó lọc ra các bạn thi lần 1,2 đều không qua để tổ chức học lại. Nhập thủ công thì rất lâu vì hàng ngàn SV
 
nbphong2019 đã viết:
Khi thi lần 1, một số bạn trượt phải thi lần 2. Thi xong phải cập nhật điểm vào với các bạn thi lần 1, sau đó lọc ra các bạn thi lần 1,2 đều không qua để tổ chức học lại. Nhập thủ công thì rất lâu vì hàng ngàn SV
Nhấp chuột vào đây để mở rộng...
Vậy là cứ sinh viên nào có điểm thi lần 2 là chèn vào dữ liệu lần 1.À.
 
nbphong2019 đã viết:
Đúng vậy, tìm theo mã sinh viên rồi chèn vào
Nhấp chuột vào đây để mở rộng...
Bạn xem code này nhé.Chọn file cần cập nhập kết quả.Có thể chọn được nhiều file nhé.
Mã: 
Sub capnhapdiemlan2()
Dim arr, arr1, i As Long, j As Long, lr As Long, dic As Object, k, wb As Workbook, a As Long, dk As String
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr < 3 Then Exit Sub
     arr = .Range("A1:M" & lr).Value
End With
With Application.FileDialog(msoFileDialogFilePicker)
     .AllowMultiSelect = True
     .Show
     For Each k In .SelectedItems
     Set wb = Workbooks.Open(k)
     a = wb.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
     If a > 4 Then
        arr1 = wb.Sheets(1).Range("A3:m" & a).Value
        For j = 6 To UBound(arr1, 2)
            If arr1(1, j) = Empty Then arr1(1, j) = arr1(1, j - 1)
               For i = 3 To UBound(arr1, 1)
                   dk = arr1(i, 2) & "#" & arr1(1, j)
                   If Len(arr1(i, j)) > 0 Then
                      dic.Item(dk) = arr1(i, j)
                   End If
               Next i
        Next j
    End If
    wb.Close False
    Next
End With
    For j = 6 To UBound(arr, 2)
            If arr(1, j) = Empty Then arr(1, j) = arr(1, j - 1)
               For i = 3 To UBound(arr, 1)
                   dk = arr(i, 2) & "#" & arr(1, j)
               If dic.exists(dk) Then
                  arr(i, j) = dic.Item(dk)
               End If
               Next i
    Next j
With Sheets("sheet1")
     .Range("A1:M" & lr).Value = arr
End With
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End Sub
 

File đính kèm

snow25 đã viết:
Bạn xem code này nhé.Chọn file cần cập nhập kết quả.Có thể chọn được nhiều file nhé.
Mã: 
Sub capnhapdiemlan2()
Dim arr, arr1, i As Long, j As Long, lr As Long, dic As Object, k, wb As Workbook, a As Long, dk As String
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr < 3 Then Exit Sub
     arr = .Range("A1:M" & lr).Value
End With
With Application.FileDialog(msoFileDialogFilePicker)
     .AllowMultiSelect = True
     .Show
     For Each k In .SelectedItems
     Set wb = Workbooks.Open(k)
     a = wb.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
     If a > 4 Then
        arr1 = wb.Sheets(1).Range("A3:m" & a).Value
        For j = 6 To UBound(arr1, 2)
            If arr1(1, j) = Empty Then arr1(1, j) = arr1(1, j - 1)
               For i = 3 To UBound(arr1, 1)
                   dk = arr1(i, 2) & "#" & arr1(1, j)
                   If Len(arr1(i, j)) > 0 Then
                      dic.Item(dk) = arr1(i, j)
                   End If
               Next i
        Next j
    End If
    wb.Close False
    Next
End With
    For j = 6 To UBound(arr, 2)
            If arr(1, j) = Empty Then arr(1, j) = arr(1, j - 1)
               For i = 3 To UBound(arr, 1)
                   dk = arr(i, 2) & "#" & arr(1, j)
               If dic.exists(dk) Then
                  arr(i, j) = dic.Item(dk)
               End If
               Next i
    Next j
With Sheets("sheet1")
     .Range("A1:M" & lr).Value = arr
End With
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn, để mình thử làm xem sao
 
nbphong2019 đã viết:
Cám ơn bạn, để mình thử làm xem sao
Nhấp chuột vào đây để mở rộng...
Bạn chạy code này xem có nhanh hơn không nhé.
Mã: 
Sub capnhapdiemlan2()
Dim arr, arr1, i As Long, j As Long, lr As Long, dic As Object, k, wb As Workbook, a As Long, dk As String, b As Long, c As Integer
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr < 3 Then Exit Sub
     arr = .Range("A1:M" & lr).Value
     For i = 3 To UBound(arr, 1)
         dic.Item(arr(i, 2)) = i
     Next i
     For j = 6 To UBound(arr, 2)
         If arr(1, j) = Empty Then arr(1, j) = arr(1, j - 1) & "#"
         dic.Item(arr(1, j)) = j
     Next j
End With
With Application.FileDialog(msoFileDialogFilePicker)
     .AllowMultiSelect = True
     .Show
     For Each k In .SelectedItems
     Set wb = Workbooks.Open(k)
     a = wb.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
     If a > 4 Then
        arr1 = wb.Sheets(1).Range("A3:m" & a).Value
        For j = 6 To UBound(arr1, 2)
            If arr1(1, j) = Empty Then arr1(1, j) = arr1(1, j - 1) & "#"
               c = dic.Item(arr1(1, j))
               If c Then
                  For i = 3 To UBound(arr1, 1)
                      b = dic.Item(arr1(i, 2))
                      If b Then
                          If Len(arr1(i, j)) > 0 Then
                             arr(b, c) = arr1(i, j)
                          End If
                      End If
                  Next i
              End If
        Next j
    End If
    wb.Close False
    Next
End With
With Sheets("sheet1")
     .Range("A1:M" & lr).Value = arr
End With
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End Sub
 

File đính kèm

snow25 đã viết:
Bạn chạy code này xem có nhanh hơn không nhé.
Mã: 
Sub capnhapdiemlan2()
Dim arr, arr1, i As Long, j As Long, lr As Long, dic As Object, k, wb As Workbook, a As Long, dk As String, b As Long, c As Integer
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr < 3 Then Exit Sub
     arr = .Range("A1:M" & lr).Value
     For i = 3 To UBound(arr, 1)
         dic.Item(arr(i, 2)) = i
     Next i
     For j = 6 To UBound(arr, 2)
         If arr(1, j) = Empty Then arr(1, j) = arr(1, j - 1) & "#"
         dic.Item(arr(1, j)) = j
     Next j
End With
With Application.FileDialog(msoFileDialogFilePicker)
     .AllowMultiSelect = True
     .Show
     For Each k In .SelectedItems
     Set wb = Workbooks.Open(k)
     a = wb.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
     If a > 4 Then
        arr1 = wb.Sheets(1).Range("A3:m" & a).Value
        For j = 6 To UBound(arr1, 2)
            If arr1(1, j) = Empty Then arr1(1, j) = arr1(1, j - 1) & "#"
               c = dic.Item(arr1(1, j))
               If c Then
                  For i = 3 To UBound(arr1, 1)
                      b = dic.Item(arr1(i, 2))
                      If b Then
                          If Len(arr1(i, j)) > 0 Then
                             arr(b, c) = arr1(i, j)
                          End If
                      End If
                  Next i
              End If
        Next j
    End If
    wb.Close False
    Next
End With
With Sheets("sheet1")
     .Range("A1:M" & lr).Value = arr
End With
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...
Bài đã được tự động gộp:

Mình thử thì cả hai cột điểm được cập nhật mới đều dạng chữ, trong khi file cần cập nhật 1 cột là điểm số, 1 cột là điểm chữ bạn ạ
Bạn giúp mình nhé. Cám ơn bạn
 

File đính kèm

Lần chỉnh sửa cuối:
nbphong2019 đã viết:
Bài đã được tự động gộp:

Mình thử thì cả hai cột điểm được cập nhật mới đều dạng chữ, trong khi file cần cập nhật 1 cột là điểm số, 1 cột là điểm chữ bạn ạ
Bạn giúp mình nhé. Cám ơn bạn
Nhấp chuột vào đây để mở rộng...
Code sau cập nhập đúng mà bạn 1 cột số 1 cột chữ mà.Bạn xem lại xem nào.
Bài đã được tự động gộp:

nbphong2019 đã viết:
Bài đã được tự động gộp:

Mình thử thì cả hai cột điểm được cập nhật mới đều dạng chữ, trong khi file cần cập nhật 1 cột là điểm số, 1 cột là điểm chữ bạn ạ
Bạn giúp mình nhé. Cám ơn bạn
Nhấp chuột vào đây để mở rộng...
Đây bạn mình gửi code bài 1.
Mã: 
Sub capnhapdiemlan21()
Dim arr, arr1, i As Long, j As Long, lr As Long, dic As Object, k, wb As Workbook, a As Long, dk As String
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr < 3 Then Exit Sub
     arr = .Range("A1:M" & lr).Value
End With
With Application.FileDialog(msoFileDialogFilePicker)
     .AllowMultiSelect = True
     .Show
     For Each k In .SelectedItems
     Set wb = Workbooks.Open(k)
     a = wb.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
     If a > 4 Then
        arr1 = wb.Sheets(1).Range("A3:m" & a).Value
        For j = 6 To UBound(arr1, 2)
            If arr1(1, j) = Empty Then arr1(1, j) = arr1(1, j - 1) & "#"
               For i = 3 To UBound(arr1, 1)
                   dk = arr1(i, 2) & "#" & arr1(1, j)
                   If Len(arr1(i, j)) > 0 Then
                      dic.Item(dk) = arr1(i, j)
                   End If
               Next i
        Next j
    End If
    wb.Close False
    Next
End With
    For j = 6 To UBound(arr, 2)
            If arr(1, j) = Empty Then arr(1, j) = arr(1, j - 1) & "#"
               For i = 3 To UBound(arr, 1)
                   dk = arr(i, 2) & "#" & arr(1, j)
               If dic.exists(dk) Then
                  arr(i, j) = dic.Item(dk)
               End If
               Next i
    Next j
With Sheets("sheet1")
     .Range("A1:M" & lr).Value = arr
End With
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End Sub
 
snow25 đã viết:
Code sau cập nhập đúng mà bạn 1 cột số 1 cột chữ mà.Bạn xem lại xem nào.
Bài đã được tự động gộp:


Đây bạn mình gửi code bài 1.
Mã: 
Sub capnhapdiemlan21()
Dim arr, arr1, i As Long, j As Long, lr As Long, dic As Object, k, wb As Workbook, a As Long, dk As String
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr < 3 Then Exit Sub
     arr = .Range("A1:M" & lr).Value
End With
With Application.FileDialog(msoFileDialogFilePicker)
     .AllowMultiSelect = True
     .Show
     For Each k In .SelectedItems
     Set wb = Workbooks.Open(k)
     a = wb.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
     If a > 4 Then
        arr1 = wb.Sheets(1).Range("A3:m" & a).Value
        For j = 6 To UBound(arr1, 2)
            If arr1(1, j) = Empty Then arr1(1, j) = arr1(1, j - 1) & "#"
               For i = 3 To UBound(arr1, 1)
                   dk = arr1(i, 2) & "#" & arr1(1, j)
                   If Len(arr1(i, j)) > 0 Then
                      dic.Item(dk) = arr1(i, j)
                   End If
               Next i
        Next j
    End If
    wb.Close False
    Next
End With
    For j = 6 To UBound(arr, 2)
            If arr(1, j) = Empty Then arr(1, j) = arr(1, j - 1) & "#"
               For i = 3 To UBound(arr, 1)
                   dk = arr(i, 2) & "#" & arr(1, j)
               If dic.exists(dk) Then
                  arr(i, j) = dic.Item(dk)
               End If
               Next i
    Next j
With Sheets("sheet1")
     .Range("A1:M" & lr).Value = arr
End With
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...
OK, rồi bạn. Cám ơn bạn đã nhiệt tình giúp đỡ. Các bước để tạo cái nút ấy làm thế nào vậy bạn, mình cũng biết sơ qua về Macro nhưng chưa làm bao giờ
 
nbphong2019 đã viết:
OK, rồi bạn. Cám ơn bạn đã nhiệt tình giúp đỡ. Các bước để tạo cái nút ấy làm thế nào vậy bạn, mình cũng biết sơ qua về Macro nhưng chưa làm bao giờ
Nhấp chuột vào đây để mở rộng...
Góp ý cho bạn:
Nên sử dụng kết quả thi vào chung một File sẽ thuận tiên hơn,
Muốn cập nhật thì chỉ cần nhấn nút, việc tìm và chọn File lâu ngày không nhớ chọn nhằm File thì sẽ nguy hại.
 
be09 đã viết:
Góp ý cho bạn:
Nên sử dụng kết quả thi vào chung một File sẽ thuận tiên hơn,
Muốn cập nhật thì chỉ cần nhấn nút, việc tìm và chọn File lâu ngày không nhớ chọn nhằm File thì sẽ nguy hại.
Nhấp chuột vào đây để mở rộng...
Cho mình hỏi chút, nếu để chung 1 file thì cập nhật thế nào vậy bạn, nút Macro mà bạn tạo có cho cập nhật dữ liệu trên cùng 1 file không
Bài đã được tự động gộp:

be09 đã viết:
Góp ý cho bạn:
Nên sử dụng kết quả thi vào chung một File sẽ thuận tiên hơn,
Muốn cập nhật thì chỉ cần nhấn nút, việc tìm và chọn File lâu ngày không nhớ chọn nhằm File thì sẽ nguy hại.
Nhấp chuột vào đây để mở rộng...
Cho mình hỏi chút, nếu để chung 1 file thì cập nhật thế nào vậy bạn, nút Macro mà bạn tạo có cho cập nhật dữ liệu trên cùng 1 file không
 
nbphong2019 đã viết:
Cho mình hỏi chút, nếu để chung 1 file thì cập nhật thế nào vậy bạn, nút Macro mà bạn tạo có cho cập nhật dữ liệu trên cùng 1 file không
Bài đã được tự động gộp:


Cho mình hỏi chút, nếu để chung 1 file thì cập nhật thế nào vậy bạn, nút Macro mà bạn tạo có cho cập nhật dữ liệu trên cùng 1 file không
Nhấp chuột vào đây để mở rộng...
Cập nhật ở đâu mà chẳng được, quan trong là cách làm sao cho nhanh, gọn.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

D
  • Question Question
Quản lý email outlook qua VBA cần giúp đỡ (5 người xem)
Trả lời
12
Đọc
202
nguyendang95
N
G
Xin Code xóa Module. (4 người xem)
Trả lời
3
Đọc
69
HUONGHCKT
H
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt (1 người xem)
    • Thích
    • Yêu thích
2
Trả lời
21
Đọc
1K
PhanTuHuong
PhanTuHuong
L
Lỗi font khi convert từ pdf (1 người xem)
Trả lời
3
Đọc
108
lamvu0677
L
N
Khắc phục lỗi "The picture is too large and will be truncated"
Trả lời
9
Đọc
5K
SonBDND
S
GPE-Trợ Lý
[GPE] TALKSHOW: PHÂN TÍCH BÁO CÁO ĐỘ NHẠY SỬ DỤNG EXCEL SOLVER (6 người xem)
    • Thích
Trả lời
0
Đọc
81
GPE-Trợ Lý
GPE-Trợ Lý
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table
Trả lời
1
Đọc
81
khkkh
K
K
Xin dax tính tỷ trọng doanh thu (1 người xem)
Trả lời
18
Đọc
754
SteveNguyen1991
S
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
6
Đọc
183
Hoàng Tuấn 868
H
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính
    • Thích
Trả lời
0
Đọc
87
nguyendang95
N
H
Nhờ anh/chị giúp đỡ em viết công thức trừ dữ liệu theo FiFo
Trả lời
1
Đọc
96
HieuCD
H
BNTT
LockXLS - Chương trình bảo vệ an toàn cho các file bảng tính Excel
    • Thích
4 5 6
Trả lời
118
Đọc
73K
YêuCN
Y
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện.
Trả lời
14
Đọc
194
thuytrangbp28
T
micam111
  • Question Question
Cách chạy nhiều đồng hồ đếm giờ trong VBA
Trả lời
4
Đọc
690
thuytrangbp28
T
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước.
    • Thích
2
Trả lời
26
Đọc
7K
Tuấn Bụng Bự
Tuấn Bụng Bự
Emyeuexcel
  • Question Question
In tất cả các file trong cùng 1 thư mục
Trả lời
3
Đọc
207
Hoàng Tuấn 868
H
1
Hỏi về đánh dấu hàng ngang hàng dọc bằng màu khi kích chuột vào 1 ô
Trả lời
7
Đọc
200
Gà Công Nghệ
Gà Công Nghệ
P
Excell code vba : Tìm Cell để sửa dữ liệu
    • Buồn
2
Trả lời
26
Đọc
579
Phạm Trường 80
P
D
Nhờ anh em giúp đỡ.
    • Buồn
Trả lời
2
Đọc
93
SA_DQ
SA_DQ
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup
Trả lời
2
Đọc
102
DeTong
D
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom