Tổng hợp kết quả sổ xố miền Bắc (3 người xem)

HungQuoc49 · 12/1/15

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.

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

quanthienhan · 12/1/15

không được Bác ơi, bác xem lại giúp em với.. !$@!!

quanthienhan · 13/1/15

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

SA_DQ · 13/1/15

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....

Thứ bảy hiện được thì các thứ khác cũng hiện được chứ, sao lại không?

quanthienhan · 13/1/15

SA_DQ đã viết:
Thứ bảy hiện được thì các thứ khác cũng hiện được chứ, sao lại không?

em cũng không biết nữa, danh sách còn hiện lại mỗi thứ 7. các thứ khác không thấy Bác ah..

quanthienhan · 13/1/15

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 ..

HungQuoc49 · 13/1/15

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 ..

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ì

quanthienhan · 13/1/15

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ì

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

SA_DQ · 13/1/15

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.

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

HungQuoc49 · 13/1/15

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

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

quanthienhan · 13/1/15

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

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..

HungQuoc49 · 13/1/15

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..

Lập cho sheet nào và chỉ cột A + cột B điền vào C thôi hả bạn.

quanthienhan · 13/1/15

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

HungQuoc49 · 13/1/15

quanthienhan đã viết:
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

bạn cho ví dụ cụ thể đi, vì trong sheet thu: cột B là rỗng và cột C là cột chứa dữ liệu.
cụ thể ô nào cộng ô nào trong sheet nào và đưa kết quả ra đâu.

quanthienhan · 13/1/15

HungQuoc49 đã viết:
bạn cho ví dụ cụ thể đi, vì trong sheet thu: cột B là rỗng và cột C là cột chứa dữ liệu.
cụ thể ô nào cộng ô nào trong sheet nào và đưa kết quả ra đâu.

bạn xem giúp mình , mình gửi file.

HungQuoc49 · 14/1/15

quanthienhan đã viết:
bạn xem giúp mình , mình gửi file.

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

quanthienhan · 14/1/15

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 +-+-+-+

Tổng hợp kết quả sổ xố miền Bắc (3 người xem)

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

Thành viên tiêu biểu

Thành viên hoạt động

Thành viên hoạt động

/(hông là gì!

Thành viên hoạt động

Thành viên hoạt động

Thành viên tiêu biểu

Thành viên hoạt động

File đính kèm

/(hông là gì!

Thành viên tiêu biểu

Thành viên hoạt động

Thành viên tiêu biểu

Thành viên hoạt động

Thành viên tiêu biểu

Thành viên hoạt động

File đính kèm

Thành viên tiêu biểu

Thành viên hoạt động

Đếm ngược thời gian