Các ANH/CHỊ giúp em đoạn code VBA

Liên hệ QC
D

dongoclinh.vcli

Thành viên mới
Tham gia
19/2/19
Bài viết
9
Được thích
0
Chào các anh/chị,

Các anh chị giúp em đoạn code VBA với ạ!
Ngày trước em làm trên bảng tính excel sau đó dùng vòng for chạy cho tất cả khách hàng. Nhưng do số lượng KH quá lớn (>7000) nên rất lâu.
Vậy các anh/chị giúp em đoạn code VBA để tính nhanh hơn với ạ!

Thông tin em đã nêu đầy đủ trong file excel, mong các anh/chị giúp đỡ ạ!

Em cảm ơn các anh/chị nhiều!

:) :) :)
 

File đính kèm

  • file tinh gia.xlsx
    13.2 KB · Đọc: 31
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Cứ ba bữa lại có kẻ réo cao thủ.
Cao thủ chưa làm nổi bài này đâu.
Muốn giải thì phải vời thánh thủ.
 
Upvote 0
dongoclinh.vcli đã viết:
Chào các anh/chị,

Các anh chị giúp em đoạn code VBA với ạ!
Ngày trước em làm trên bảng tính excel sau đó dùng vòng for chạy cho tất cả khách hàng. Nhưng do số lượng KH quá lớn (>7000) nên rất lâu.
Vậy các anh/chị giúp em đoạn code VBA để tính nhanh hơn với ạ!

Thông tin em đã nêu đầy đủ trong file excel, mong các anh/chị giúp đỡ ạ!

Em cảm ơn các anh/chị nhiều!

:):):)
Nhấp chuột vào đây để mở rộng...
Bạn cần gì thì cứ viết ra bình thường thôi.Bạn nên sửa tiêu đề đi không bài bị khoá bây giờ.
 
Upvote 0
dongoclinh.vcli đã viết:
Chào các anh/chị,

Các anh chị giúp em đoạn code VBA với ạ!
Ngày trước em làm trên bảng tính excel sau đó dùng vòng for chạy cho tất cả khách hàng. Nhưng do số lượng KH quá lớn (>7000) nên rất lâu.
Vậy các anh/chị giúp em đoạn code VBA để tính nhanh hơn với ạ!

Thông tin em đã nêu đầy đủ trong file excel, mong các anh/chị giúp đỡ ạ!

Em cảm ơn các anh/chị nhiều!

:):):)
Nhấp chuột vào đây để mở rộng...
Chỉnh lại tiêu đề bỏ từ "cao thủ"
Gởi lại file với tiếng việt đầy đủ các từ thay thế "a", "b" ...
Cùng mã khách hàng các dòng liên tiếp nhau hay nằm rải rác xen kẻ?
 
Upvote 0
Cũng tùy thánh. Có thánh thì không có chuối không có xôi cũng được, nhưng phải có gà và "nước lửa"

Nhưng cũng có thánh thì thẻ cào cũng được. :D
 
Upvote 0
Hình như muốn cưỡi Mada tiền tỷ thì chỉ nên cốt Xê Cọng Cọng thôi, những gì cần viết bằng Vê Bê A thì gởi lên Dê Pê E.
 
Upvote 0
Thánh bây giờ xài phây búp, sờ mát phôn lai chim, công nghệ hết rồi nên không còn nhận chuối xôi gà nữa nhé!
 
Upvote 0
Bạn dùng thử tool này nhé
 

File đính kèm

  • Linhdemo.zip
    2.5 MB · Đọc: 9
Upvote 0
HieuCD đã viết:
Chỉnh lại tiêu đề bỏ từ "cao thủ"
Gởi lại file với tiếng việt đầy đủ các từ thay thế "a", "b" ...
Cùng mã khách hàng các dòng liên tiếp nhau hay nằm rải rác xen kẻ?
Nhấp chuột vào đây để mở rộng...

Dạ tại các mã nó dài quá nên e đặt lại cho gọn, với nó cũng là ký tự cả chữ cả số ạ!
Với 1 KH thì thứ tự mã SP là random, chỉ có mã KH là nằm kề nhau thôi ạ!
Cảm ơn anh đã có ý kiến :)
Bài đã được tự động gộp:

Dear các ANH/CHỊ,
Do lần đầu đăng bài nên em chưa có nhiều kinh nghiệm. Mong các ANH/CHỊ thông cảm, em sẽ rút kinh nghiệm trong lần sau.
Tính chất công việc hiện tại cần nhiều VBA (do quản lý lượng data lớn) nên sẽ có nhiều câu hỏi "ngây thơ" mong các ANH CHỊ giải đáp.
Trước em làm quản lý chủ yếu bằng bảng tính excel, nếu lượng KH khoảng vài trăm thì em hay dùng vòng For để chạy. Hiện giờ thì lên đến vài chục nghìn, mỗi lần chạy hết cả 4-5 tiếng nên em cần sự giúp đỡ của các ANH CHỊ.

Cảm ơn sự giúp đỡ và góp ý nhiệt tình của các ANH/CHỊ ạ!
Chúc ANH CHỊ cuối tuần vui vẻ :) :) :)
Bài đã được tự động gộp:

Syn.nguyen đã viết:
Bạn dùng thử tool này nhé
Nhấp chuột vào đây để mở rộng...
Dạ em cảm ơn sự giúp đỡ của ANH/CHỊ!
Em xem luôn và nếu có thắc mắc mong ANH/CHỊ giúp đỡ!

Hiện bài toán này em cũng đang code, nếu hoàn thiện em sẽ đăng lên để các ANH CHỊ góp ý!

:)
 
Lần chỉnh sửa cuối:
Upvote 0
dongoclinh.vcli đã viết:
Dạ tại các mã nó dài quá nên e đặt lại cho gọn, với nó cũng là ký tự cả chữ cả số ạ!
Với 1 KH thì thứ tự mã SP là random, chỉ có mã KH là nằm kề nhau thôi ạ!
Cảm ơn anh đã có ý kiến :)
Bài đã được tự động gộp:

Dear các ANH/CHỊ,
Do lần đầu đăng bài nên em chưa có nhiều kinh nghiệm. Mong các ANH/CHỊ thông cảm, em sẽ rút kinh nghiệm trong lần sau.
Tính chất công việc hiện tại cần nhiều VBA (do quản lý lượng data lớn) nên sẽ có nhiều câu hỏi "ngây thơ" mong các ANH CHỊ giải đáp.
Trước em làm quản lý chủ yếu bằng bảng tính excel, nếu lượng KH khoảng vài trăm thì em hay dùng vòng For để chạy. Hiện giờ thì lên đến vài chục nghìn, mỗi lần chạy hết cả 4-5 tiếng nên em cần sự giúp đỡ của các ANH CHỊ.

Cảm ơn sự giúp đỡ và góp ý nhiệt tình của các ANH/CHỊ ạ!
Chúc ANH CHỊ cuối tuần vui vẻ :):):)
Bài đã được tự động gộp:


Dạ em cảm ơn sự giúp đỡ của ANH/CHỊ!
Em xem luôn và nếu có thắc mắc mong ANH/CHỊ giúp đỡ!

Hiện bài toán này em cũng đang code, nếu hoàn thiện em sẽ đăng lên để các ANH CHỊ góp ý!

:)
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub GPE()
  Dim sArr()
  Dim i As Long, ik As Long
  Dim eDay, KyHan As Double, SoTien As Double
 
  i = Range("A1000000").End(xlUp).Row
  If i < 2 Then Exit Sub
  sArr = Range("A1:E" & i + 1).Value
  eDay = Range("H1").Value
  If TypeName(eDay) = "Empty" Then eDay = Date
  If TypeName(eDay) = "Date" Then
    iStr = "#c#a#b#e#"
    For i = 2 To UBound(sArr) - 1
      If sArr(i, 1) <> sArr(i - 1, 1) Then
        If sArr(i, 4) Like "Th?ng" Then
          KyHan = 1
        ElseIf sArr(i, 4) Like "Qu?" Then
          KyHan = 3
        ElseIf sArr(i, 4) Like "N?a n?m" Then
          KyHan = 6
        ElseIf sArr(i, 4) Like "N?m" Then
          KyHan = 12
        End If
        KyHan = Int((eDay - sArr(i, 3) + 1) / 30 / KyHan)
        SoTien = 0: ik = 0
      End If
    
      If sArr(i, 2) = "d" Then
        ik = i
      ElseIf sArr(i, 2) = "c" Then
        SoTien = SoTien + sArr(i, 5) / 2
      Else
        SoTien = SoTien + sArr(i, 5)
      End If
      If sArr(i, 1) <> sArr(i + 1, 1) Then
        If ik > 0 Then sArr(ik, 5) = SoTien * KyHan
      End If
    Next i
    Range("A1:E1").Resize(UBound(sArr)) = sArr
  End If
End Sub
 

File đính kèm

  • file tinh gia.xlsm
    20.2 KB · Đọc: 10
Upvote 0
HieuCD đã viết:
Mã: 
Sub GPE()
  Dim sArr()
  Dim i As Long, ik As Long
  Dim eDay, KyHan As Double, SoTien As Double

  i = Range("A1000000").End(xlUp).Row
  If i < 2 Then Exit Sub
  sArr = Range("A1:E" & i + 1).Value
  eDay = Range("H1").Value
  If TypeName(eDay) = "Empty" Then eDay = Date
  If TypeName(eDay) = "Date" Then
    iStr = "#c#a#b#e#"
    For i = 2 To UBound(sArr) - 1
      If sArr(i, 1) <> sArr(i - 1, 1) Then
        If sArr(i, 4) Like "Th?ng" Then
          KyHan = 1
        ElseIf sArr(i, 4) Like "Qu?" Then
          KyHan = 3
        ElseIf sArr(i, 4) Like "N?a n?m" Then
          KyHan = 6
        ElseIf sArr(i, 4) Like "N?m" Then
          KyHan = 12
        End If
        KyHan = Int((eDay - sArr(i, 3) + 1) / 30 / KyHan)
        SoTien = 0: ik = 0
      End If
   
      If sArr(i, 2) = "d" Then
        ik = i
      ElseIf sArr(i, 2) = "c" Then
        SoTien = SoTien + sArr(i, 5) / 2
      Else
        SoTien = SoTien + sArr(i, 5)
      End If
      If sArr(i, 1) <> sArr(i + 1, 1) Then
        If ik > 0 Then sArr(ik, 5) = SoTien * KyHan
      End If
    Next i
    Range("A1:E1").Resize(UBound(sArr)) = sArr
  End If
End Sub
Nhấp chuột vào đây để mở rộng...
Em vẫn thích dùng dic hơn.:d
 
Upvote 0
HieuCD đã viết:
Mã: 
Sub GPE()
  Dim sArr()
  Dim i As Long, ik As Long
  Dim eDay, KyHan As Double, SoTien As Double

  i = Range("A1000000").End(xlUp).Row
  If i < 2 Then Exit Sub
  sArr = Range("A1:E" & i + 1).Value
  eDay = Range("H1").Value
  If TypeName(eDay) = "Empty" Then eDay = Date
  If TypeName(eDay) = "Date" Then
    iStr = "#c#a#b#e#"
    For i = 2 To UBound(sArr) - 1
      If sArr(i, 1) <> sArr(i - 1, 1) Then
        If sArr(i, 4) Like "Th?ng" Then
          KyHan = 1
        ElseIf sArr(i, 4) Like "Qu?" Then
          KyHan = 3
        ElseIf sArr(i, 4) Like "N?a n?m" Then
          KyHan = 6
        ElseIf sArr(i, 4) Like "N?m" Then
          KyHan = 12
        End If
        KyHan = Int((eDay - sArr(i, 3) + 1) / 30 / KyHan)
        SoTien = 0: ik = 0
      End If
  
      If sArr(i, 2) = "d" Then
        ik = i
      ElseIf sArr(i, 2) = "c" Then
        SoTien = SoTien + sArr(i, 5) / 2
      Else
        SoTien = SoTien + sArr(i, 5)
      End If
      If sArr(i, 1) <> sArr(i + 1, 1) Then
        If ik > 0 Then sArr(ik, 5) = SoTien * KyHan
      End If
    Next i
    Range("A1:E1").Resize(UBound(sArr)) = sArr
  End If
End Sub
Nhấp chuột vào đây để mở rộng...
Cái này gọi là "tối ưu hóa vòng lặp" anh ạ ;)
 
Upvote 0
HieuCD đã viết:
Mã: 
Sub GPE()
  Dim sArr()
  Dim i As Long, ik As Long
  Dim eDay, KyHan As Double, SoTien As Double

  i = Range("A1000000").End(xlUp).Row
  If i < 2 Then Exit Sub
  sArr = Range("A1:E" & i + 1).Value
  eDay = Range("H1").Value
  If TypeName(eDay) = "Empty" Then eDay = Date
  If TypeName(eDay) = "Date" Then
    iStr = "#c#a#b#e#"
    For i = 2 To UBound(sArr) - 1
      If sArr(i, 1) <> sArr(i - 1, 1) Then
        If sArr(i, 4) Like "Th?ng" Then
          KyHan = 1
        ElseIf sArr(i, 4) Like "Qu?" Then
          KyHan = 3
        ElseIf sArr(i, 4) Like "N?a n?m" Then
          KyHan = 6
        ElseIf sArr(i, 4) Like "N?m" Then
          KyHan = 12
        End If
        KyHan = Int((eDay - sArr(i, 3) + 1) / 30 / KyHan)
        SoTien = 0: ik = 0
      End If
   
      If sArr(i, 2) = "d" Then
        ik = i
      ElseIf sArr(i, 2) = "c" Then
        SoTien = SoTien + sArr(i, 5) / 2
      Else
        SoTien = SoTien + sArr(i, 5)
      End If
      If sArr(i, 1) <> sArr(i + 1, 1) Then
        If ik > 0 Then sArr(ik, 5) = SoTien * KyHan
      End If
    Next i
    Range("A1:E1").Resize(UBound(sArr)) = sArr
  End If
End Sub
Nhấp chuột vào đây để mở rộng...
Dòng này đáng giá thật
Mã: 
iStr = "#c#a#b#e#"
 
Upvote 0
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

C
  • Question
VBA copy 2 vùng dữ liệu từ 1 workbook này sang 2 vùng của workbook khác!
    • Phẫn nộ
Trả lời
4
Đọc
66
cuongbv2103
C
Emyeuexcel
  • Question
In theo số thứ tự
    • Chấp nhận
Trả lời
2
Đọc
40
Emyeuexcel
Emyeuexcel
M
...
    • Cười
Trả lời
4
Đọc
63
Hoàng Tuấn 868
H
phanngoctrai1981
  • Question
Tính trung bình theo các nhóm bằng VBA
Trả lời
6
Đọc
132
Hoàng Tuấn 868
H
kiencuong030184
  • Question
ẩn hiện dòng, cột có điều kiên
Trả lời
1
Đọc
21
SA_DQ
SA_DQ
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom