Tổng hợp kết quả sổ xố miền Bắc (1 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)
Q

quanthienhan

Thành viên hoạt động
Tham gia
4/2/07
Bài viết
120
Được thích
3
Em chào các Anh chị trên DD..các A,C trên DD xem giúp em có công thức hay code nào để có thể giúp em ( Tổng hợp kết quả sổ xố miền Bắc Từ ngày 1-1-2007 đến ngày 10-1-2015 không ạ..) Như hiện tại em đang làm thủ công từng bước một ..
1…sheet layketqua…em coppy kết quả từ trang ketqua888.
2... sau đó coppy dữ liệu kết quả vào sheet DulieuKetQua...
* mong muốn của em ..nhờ các A,C trên này có thể giúp em , tổng hợp kết quả như sheet DLKQ từ năm 2007 đến 2015, không phải làm thủ công như em ah...
* mong muốn thứ 2 nữa là có thể thêm các sheet tổng hợp kết quả theo thứ riêng nữa ah..từ thứ 2 đến chủ nhật..
*** em xin chân thành cảm ơn các Anh Chị nhiều ***+-+-+-+
 

File đính kèm

Trang 'LayKetQua' của bạn quá ít số liệu
 
Cám ơn bạn HYen17..trang đó mình làm thủ công coppy từng ngày 1 bạn ah, nên số liệu ít, không biết có cách nào ,tự động upload kết quả như mình muốn không các A,C ơi..
 
quanthienhan đã viết:
Cám ơn bác nhiều .đúng là dữ liệu em cần rồi ...nhưng Bác cho hỏi, có cách nào chuyển dữ liệu file kết quả trên sang kiểu dữ liệu như file của em không ah, xin cảm ơn bác nhiều.
Nhấp chuột vào đây để mở rộng...
Chuyển sang cũng không có gì quá phức tạp.
Bạn làm một vài kết quả mẫu rồi đính kèm gửi lên xem sao.
 
HungQuoc49 đã viết:
Chuyển sang cũng không có gì quá phức tạp.
Bạn làm một vài kết quả mẫu rồi đính kèm gửi lên xem sao.
Nhấp chuột vào đây để mở rộng...
Vâng bác em làm thử mẫu mời Bác xem, em dựa trên dữ liệu kết quả bác gửi, có điều em sắp xếp lại chút thứ tự các giá trị theo điều em cần ah. mời bác xem giúp em+-+-+-+
 
[Thongbao]Cám ơn bác nhiều .đúng là dữ liệu em cần rồi ...
Nhưng có cách nào chuyển dữ liệu file kết quả trên sang kiểu dữ liệu như file của em không ah, xin cảm ơn bác nhiều.[/thOngbao]

Cảm ơn HungQuoc49 do file!
 

File đính kèm

HYen17 đã viết:
[Thongbao]Cám ơn bác nhiều .đúng là dữ liệu em cần rồi ...
Nhưng có cách nào chuyển dữ liệu file kết quả trên sang kiểu dữ liệu như file của em không ah, xin cảm ơn bác nhiều.[/Thongbao]

Cảm ơn HungQuoc49 do file!
Nhấp chuột vào đây để mở rộng...
em Xin cảm ơn Bác nhiều nha}}}}}...
làm phiền bác chút nữa nếu có thể được.. bác giúp em hiểu chút code bác viết cho em được không ..thanhk Bác nhiều
 
PHP: 
Option Explicit
Sub ChuyenDuLieu()
 Dim Sh As Worksheet, Rng As Range, Cls As Range
 Dim J As Byte, Col As Byte, Rws As Integer, Tmr As Double
 
1 Set Sh = ThisWorkbook.Worksheets("SoLieu")
 Set Rng = Sh.Range(Sh.[f11], Sh.[f11].End(xlDown))
3 Columns("A:o").ClearContents:                          Tmr = Timer()
 For Each Cls In Rng
5    With [a65500].End(xlUp).Offset(2)
        .Value = Cls.Offset(, 2).Value                  'Nhát'
7        .Offset(, 13).Value = Cls.Value                 'Ngày'
        .Offset(, 14).Value = Cls.Offset(, -4).Value    'Thú'
9        For J = 1 To 26
            Rws = Choose(J, 1, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 6, 6, 7, 7, 7, 8, 8, 8, 9, 9, 9, 10, 10, 10, 10)
11            Col = Choose(J, 0, 0, 2, 0, 3, 4, 0, 3, 4, 0, 2, 0, 2, 0, 2, 4, 0, 2, 4, 0, 2, 4, 0, 2, 4, 6)
            .Offset(Rws, Col).Value = Cls.Offset(, 2 + J)
13        Next J
    End With
15 Next Cls
 Randomize:                                             [N1].Value = Timer() - Tmr
 Union([h1].Resize(110), [j1].Resize(110)).Interior.ColorIndex = 34 + 9 * Rnd() / 1
End Sub

Hai dòng lệnh trên số 1: Khai báo các loại biến cần dùng;
D1: Đem trang tính chứa dữ liệu gán vô 1 biến đối tượng;
D2: Đem vùng các ô thuộc cột [F] (Trường ngày-tháng) gán vô 1 biến vùng;
D3: Mệnh đề 1: Xóa vùng số liệu do macro chạy lần trước đưa ra;
Mệnh đề sau: Ghi thời gian hiện tại vô biến;
D4: Thiết lập vòng lặp duyệt tất thẩy các ô trong biến vùng; Vòng lặp này kết thúc ở dòng lệnh D15;
D5: Tuyên cáo (TC) làm việc với ô cách ô dưới cùng có dữ liệu thuộc cột [A] 2 ô;
(Tuyên cáo này kết thúc tại D14)
D6: Gán số liệu giải Nhất vô ô đã TC;
D7& D8: Gán trị ngày-tháng & thứ vô cột qui định theo cùng dòng TC
D9: Thiết lập vòng lặp khác để duyệt 26 giải thưởng còn lại; Vòng lặp này kết thúc tại D13;
D10: Cho biến Rws nhận những giá trị tương ứng với những hàng (dòng) cách với dòng đã TC
D11: Tương tự cho biến Col nhận những trị cách với cột đã TC về fía fải;
D12: (Quả tim của macro) Lấy trị tương ứng lần lượt từ các giải gán lên trang tính hiện hành (Trang có nút lệnh macro)
. . . . . (Mấy dòng còn lại bạn tự tìm hiểu, vì chúng cũng chỉ là fù fiếm

Chúc ngày cuối tuần vui vẻ & thành công!
 
Lần chỉnh sửa cuối:
Các bác có thể giúp em thêm tí nữa được không ạ..dữ liệu cột D có thể dịch vô cột C được không vậy..giúp em code thêm nốt mấy sheet tổng hợp , các thứ trong tuần như file em gửi được không a..xin cảm ơn các bác rất nhiều..
 
[thongbao]Các bác có thể giúp em thêm tí nữa được không ạ:
(2). Dữ liệu cột D có thể dịch vô cột C được không vậy..
(1) Giúp em code thêm nốt mấy sheet tổng hợp , các thứ trong tuần như file em gửi được không a....[/ThongBao]


(1) Xem file đính kèm; Chọn 1 ngày trong tuần để có kết quả; Macro nớ đã tăng tốc bỡi xử trong Array
(2) Chưa hiểu chuyển bảng dữ liệu nào, nguồn hay đích?
(Nếu đích mà chỉ chuyển cột trống thì có nghĩa gì cơ chứ?)
 

File đính kèm

HYen17 đã viết:
[thongbao]Các bác có thể giúp em thêm tí nữa được không ạ:
(2). Dữ liệu cột D có thể dịch vô cột C được không vậy..
(1) Giúp em code thêm nốt mấy sheet tổng hợp , các thứ trong tuần như file em gửi được không a....[/thongbao]


(1) Xem file đính kèm; Chọn 1 ngày trong tuần để có kết quả; Macro nớ đã tăng tốc bỡi xử trong Array
(2) Chưa hiểu chuyển bảng dữ liệu nào, nguồn hay đích?
(Nếu đích mà chỉ chuyển cột trống thì có nghĩa gì cơ chứ?)
Nhấp chuột vào đây để mở rộng...
Xin cám ơn bạn Hyen17 rất nhiều..rất nhiều ah, có một chút thắc mác nữa bạn HYen17 sửa giúp tí nữa được không ah..các ô có dữ liệu số ( 0 ) ở trước thì không hiện lên..bạn có thể chỉnh code một chút nữa để ô giá trị có số 0 đứng trước vẫn hiện lên số 0 như bên sheet1 được không bạn..chân thành cảm ơn bạn nhiều.
 
Các Anh Chị trên DĐ xem giúp em nốt cái code bên sheet thứ này nha.
xin cảm ơn rất nhiều+-+-+-+
 
Có một chút thắc mác nữa bạn sửa giúp tí nữa được không ah..các ô có dữ liệu số ( 0 ) ở trước thì không hiện lên..bạn có thể chỉnh code một chút nữa để ô giá trị có số 0 đứng trước vẫn hiện lên số 0 như bên sheet1 được không bạn..chân thành cảm ơn bạn nhiều.
Nhấp chuột vào đây để mở rộng...

Bạn tìm đến dòng lệnh của macro sự kiện của trang nớ
& thêm vố dòng lệnh
Mã: 
    ReDim dArr(1 To 65500, 1 To 8)

thành ra là:
PHP: 
    ReDim dArr(1 To 65500, 1 To 8) As String

(húc thành công!
 
SA_DQ đã viết:
Bạn tìm đến dòng lệnh của macro sự kiện của trang nớ
& thêm vố dòng lệnh
Mã: 
    ReDim dArr(1 To 65500, 1 To 8)

thành ra là:
PHP: 
    ReDim dArr(1 To 65500, 1 To 8) As String

(húc thành công!
Nhấp chuột vào đây để mở rộng...
vâng em cám ơn Bác nhiều, có điều em không biết nhiều về excel. em thay vào như bác nói, ok chạy rồi ạ đúng như em muốn. có điều chỉ hiện được mỗi dữ liệu thứ 7 thôi ah..hay do em không biết cách làm....nếu được xin bác có thể giúp em được không a..em xin cảm ơn rất nhiều.
 
quanthienhan đã viết:
vâng em cám ơn Bác nhiều, có điều em không biết nhiều về excel. em thay vào như bác nói, ok chạy rồi ạ đúng như em muốn. có điều chỉ hiện được mỗi dữ liệu thứ 7 thôi ah..hay do em không biết cách làm....nếu được xin bác có thể giúp em được không a..em xin cảm ơn rất nhiều.
Nhấp chuột vào đây để mở rộng...
Làm như bài 19
PHP: 
ReDim dArr(1 To 65500, 1 To 8)
thay bằng
PHP: 
ReDim dArr(1 To 65500, 1 To 8) as String


Và tìm thêm dòng này
PHP: 
dArr(Dg + Rw, Col) = sArr(J, 7 + W)
thay bằng
PHP: 
dArr(Dg + Rw, Col) = Right(1000000 + sArr(J, 7 + W), Len(sArr(J, 7 + W)))

Rồi chạy thử xem sao
 
không được Bác ơi, bác xem lại giúp em với..!$@!!!$@!!!$@!!
 
có Bác nào đi qua , bớt chút thời gian sửa dùm em với, em xin cảm ơn rất nhiều
 
có điều chỉ hiện được mỗi dữ liệu thứ 7 thôi ah..hay do em không biết cách làm....
Nhấp chuột vào đây để mở rộng...

Thứ bảy hiện được thì các thứ khác cũng hiện được chứ, sao lại không?
 
Các Bác ơi giúp em với, các Bác có thể làm giúp em luôn được không vậy, em sợ em không biết chạy code , nên có lỗi gì chăng. em xin cảm ơn nhiều ..
 
quanthienhan đã viết:
Các Bác ơi giúp em với, các Bác có thể làm giúp em luôn được không vậy, em sợ em không biết chạy code , nên có lỗi gì chăng. em xin cảm ơn nhiều ..
Nhấp chuột vào đây để mở rộng...
Copy code trong file của bạn HYen

PHP: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [J1]) Is Nothing Then
    Dim Rws As Long, J As Long, Tmr As Double, Dg As Long
    Dim W As Long, Rw As Byte, Col As Byte
    Dim sArr(), Sh As Worksheet
    On Error GoTo Loi_CT
  
    Set Sh = Sheets("SoLieu"):              Tmr = Timer()
    Rws = Sh.[B11].CurrentRegion.Rows.Count
    sArr() = Sh.[B11].Resize(Rws, 33).Value
    ReDim dArr(1 To 65500, 1 To 8) As String '<---Đã sửa chỗ này
    For J = 1 To Rws
        If sArr(J, 1) = Target.Value Then
            Dg = Dg + 1
            dArr(Dg, 1) = sArr(J, 7)
            dArr(Dg, 4) = sArr(J, 5)
            dArr(Dg, 6) = sArr(J, 1)
            dArr(Dg + 1, 1) = sArr(J, 6)
            For W = 1 To 26
                Rw = Choose(W, 1, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 6, 6, 7, 7, 7, 8, 8, 8, 9, 9, 9, 10, 10, 10, 10)
                Col = Choose(W, 1, 1, 3, 1, 3, 5, 1, 3, 5, 1, 3, 1, 3, 1, 3, 5, 1, 3, 5, 1, 3, 5, 1, 3, 5, 7)
                dArr(Dg + Rw, Col) = Right(1000000 + sArr(J, 7 + W), Len(sArr(J, 7 + W))) '<---Đã sửa chỗ này
            Next W
            Dg = Dg + 11
        End If
    Next J
    [A2].Resize(65500, 8).Value = dArr()
    [h1].Value = Timer() - Tmr
  End If
 
Err_:            Exit Sub
Loi_CT:
    MsgBox Error(), , Err
    MsgBox Rw, , Col
    Resume Err_
End Sub

Dán đè code này vào file của bạn.
Chạy thử thấy cũng đạt yêu cầu
Nếu không chạy được thì đành chịu
---
Cũng không rõ bài 22 nói không được là không được cái gì
 
Lần chỉnh sửa cuối:
HungQuoc49 đã viết:
Copy code trong file của bạn HYen

PHP: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [J1]) Is Nothing Then
    Dim Rws As Long, J As Long, Tmr As Double, Dg As Long
    Dim W As Long, Rw As Byte, Col As Byte
    Dim sArr(), Sh As Worksheet
    On Error GoTo Loi_CT
  
    Set Sh = Sheets("SoLieu"):              Tmr = Timer()
    Rws = Sh.[B11].CurrentRegion.Rows.Count
    sArr() = Sh.[B11].Resize(Rws, 33).Value
    ReDim dArr(1 To 65500, 1 To 8) As String '<---Đã sửa chỗ này
    For J = 1 To Rws
        If sArr(J, 1) = Target.Value Then
            Dg = Dg + 1
            dArr(Dg, 1) = sArr(J, 7)
            dArr(Dg, 4) = sArr(J, 5)
            dArr(Dg, 6) = sArr(J, 1)
            dArr(Dg + 1, 1) = sArr(J, 6)
            For W = 1 To 26
                Rw = Choose(W, 1, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 6, 6, 7, 7, 7, 8, 8, 8, 9, 9, 9, 10, 10, 10, 10)
                Col = Choose(W, 1, 1, 3, 1, 3, 5, 1, 3, 5, 1, 3, 1, 3, 1, 3, 5, 1, 3, 5, 1, 3, 5, 1, 3, 5, 7)
                dArr(Dg + Rw, Col) = Right(1000000 + sArr(J, 7 + W), Len(sArr(J, 7 + W))) '<---Đã sửa chỗ này
            Next W
            Dg = Dg + 11
        End If
    Next J
    [A2].Resize(65500, 8).Value = dArr()
    [h1].Value = Timer() - Tmr
  End If
 
Err_:            Exit Sub
Loi_CT:
    MsgBox Error(), , Err
    MsgBox Rw, , Col
    Resume Err_
End Sub

Dán đè code này vào file của bạn.
Chạy thử thấy cũng đạt yêu cầu
Nếu không chạy được thì đành chịu
---
Cũng không rõ bài 22 nói không được là không được cái gì
Nhấp chuột vào đây để mở rộng...

Dạ ý em là nó chạy bị lỗi như thế, đây em gửi file của em đã sửa theo code. trong danh sách thứ máy của em chỉ thấy hiện lên thứ 7 thôi, mấy thứ kia thì để ô trống, em xin phiền Bác thêm..em xin cảm ơn bác rất nhiều
 

File đính kèm

Trời đất! Bạn chưa có danh sách chọn trong ô [J1] thì làm sao macro nó làm việc được;

Bây giờ bạn sang trang 'SoLieu' & chép vùng [b11:B17] chép vô [O1:O7]
Khi đó trong [J1] mới có danh sách các thứ để bạn chọn.

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
quanthienhan đã viết:
Dạ ý em là nó chạy bị lỗi như thế, đây em gửi file của em đã sửa theo code. trong danh sách thứ máy của em chỉ thấy hiện lên thứ 7 thôi, mấy thứ kia thì để ô trống, em xin phiền Bác thêm..em xin cảm ơn bác rất nhiều
Nhấp chuột vào đây để mở rộng...
Gửi file thế này nhanh hết vốn lắm bạn
Chỉ cần miêu tả rõ lỗi là được
 
HungQuoc49 đã viết:
Gửi file thế này nhanh hết vốn lắm bạn
Chỉ cần miêu tả rõ lỗi là được
Nhấp chuột vào đây để mở rộng...
Hii..em có nói lỗi rồi mà, chắc do em không hiểu biết nhiều nên, làm mọi người mất thời gian nhiều quá. giờ thì ok rồi..Em xin chân thành cảm ơn mọi người nhiều lắm...
..Em xin làm phiền một tí nhỏ nhoi nữa thôi ah...em xin hàm sau: ( A1+B1 =C1=1x)
Em cần C1 chỉ hiên giá trị sau cùng của phép tổng A1+B1, tức là ( x)...VD..A1=5, B1=7 tổng A1+B1=12=C1, mà em chỉ muốn C1 hiện 1 giá trị sau cùng tức là 2...các bác cho em xin thêm chút thời gian nha..
 
quanthienhan đã viết:
Hii..em có nói lỗi rồi mà, chắc do em không hiểu biết nhiều nên, làm mọi người mất thời gian nhiều quá. giờ thì ok rồi..Em xin chân thành cảm ơn mọi người nhiều lắm...
..Em xin làm phiền một tí nhỏ nhoi nữa thôi ah...em xin hàm sau: ( A1+B1 =C1=1x)
Em cần C1 chỉ hiên giá trị sau cùng của phép tổng A1+B1, tức là ( x)...VD..A1=5, B1=7 tổng A1+B1=12=C1, mà em chỉ muốn C1 hiện 1 giá trị sau cùng tức là 2...các bác cho em xin thêm chút thời gian nha..
Nhấp chuột vào đây để mở rộng...

Lập cho sheet nào và chỉ cột A + cột B điền vào C thôi hả bạn.
 
dạ vâng ạ...bác chỉ thêm cho em vài chữ nữa nha..cám ơn bác rất nhiều
 
quanthienhan đã viết:
bạn xem giúp mình , mình gửi file.
Nhấp chuột vào đây để mở rộng...
dán code này vào xem sao
PHP: 
Public Sub Tinh_Tong()
Dim DL, Kq(), r As Long
DL = Sheet2.Range("A1", Sheet2.Range("A1000000").End(xlUp))
ReDim Kq(1 To UBound(DL), 1 To 3)

For r = 1 To UBound(DL) Step 12
Kq(r, 1) = Mid(DL(r, 1), 4, 1)
Kq(r, 2) = Mid(DL(r, 1), 5, 1)
Kq(r, 3) = (Val(Kq(r, 1)) + Val(Kq(r, 2))) Mod 10
Next r
Sheet2.Range("H1").Resize(UBound(Kq), 3).Value = Kq

End Sub
 
mình đã làm được rồi. xin cảm ơn bạn nhiều..chúc bạn một ngày vui vẻ..thanks+-+-+-+
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
578
Đọc
82K
tuanktt3
T
E
  • Đã giải quyết
VBA code thay thế cho pivot-table lấy top 10, bottom 10 (1 người xem)
    • Thích
Trả lời
24
Đọc
444
eagle12
E
D
  • Question Question
Tách dòng tự động theo điều kiện bằng VBA (1 người xem)
    • Cười
Trả lời
9
Đọc
191
HUONGHCKT
H
PhanTuHuong
Nếu diễn đàn GPE đóng cửa?
    • Thích
    • Yêu thích
Trả lời
12
Đọc
248
kiendt1973
K
HeSanbi
Thuật ngữ "Đối chiếu Unicode" quan trọng trong việc xử lý chuỗi ký tự
Trả lời
1
Đọc
107
jonythanht
J
P
Lỗi hàm VBA phải add-in sau mỗi lần mở file (1 người xem)
Trả lời
0
Đọc
29
phamdinh.huy.aladin@gmail
P
D
Xin giúp.......Kết hợp countifs và Sumproduct để đếm dữ liệu và tính số lượng tổng không trùng lặp với nhiều điều kiện
Trả lời
10
Đọc
258
dieppk.nb92
D
H
tìm kiếm nội dung liên kết giữa cac bảng , cac sheet trong excel
Trả lời
2
Đọc
87
DeTong
D
N
Công thức trích xuất riêng các ký tự trong chuỗi họ tên
Trả lời
7
Đọc
109
Ngựa con 2002
N
Q
Nhờ các chị cho em xin công thức đếm bản ghi loại bỏ dữ liệu trùng lặp với nhiều điều kiện
Trả lời
2
Đọc
114
dungpham01
D
huuthang_bd
Cùng xây dựng file Gia Phả
    • Thích
Trả lời
36
Đọc
21K
le_vis
L
D
Công thức tính thuế thu nhập cá nhân mới nhất theo mức 5 bậc
Trả lời
14
Đọc
668
Cúc Hr
C
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Cảm ơn
    • Thích
Trả lời
8
Đọc
2K
PhanTuHuong
PhanTuHuong
D
  • Question Question
IN TỰ ĐỘNG TỪ DỮ LIỆU CÓ SẴN
Trả lời
14
Đọc
450
duongnhuxuyen
D
V
Biểu diễn số đếm theo hình vẽ từ Shape
Trả lời
34
Đọc
672
Vũ Hải Sơn
V
T
Xử lý lỗi xuất hiện màu cam khi chọn 1 ô trong excel.
Trả lời
1
Đọc
100
Maika8008
Maika8008
L
  • Question Question
Tạo ComboBox để tìm kiếm tên
Trả lời
4
Đọc
195
HUONGHCKT
H
T
Điên đầu vì Countif
Trả lời
5
Đọc
265
87kilua
87kilua
H
Quên mật khẩu khóa protect (1 người xem)
Trả lời
22
Đọc
1K
Gà Con yêu VBA
Gà Con yêu VBA
HeSanbi
  • Question Question
Hướng dẫn sửa lỗi không khởi động được ứng dụng Excel
    • Thích
    • Yêu thích
Trả lời
0
Đọc
114
HeSanbi
HeSanbi
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom