Bài tập về vòng lặp (1 người xem)

[ndu96081631]

Những ai đã từng xem qua bài viết này: Giới thiệu Cơ bản về vòng lặp For . . . next của sư phụ ptm0412 giờ hãy cùng làm 1 vài bài tập từ đơn giản đến nâng cao nhé
Xin mở màn bằng 1 bài tập sau:

Bài tập 01:

Hãy tính xem từ năm 1900 đến nay có bao nhiêu ngày thuộc dạng THỨ SÁU NGÀY 13
------------------------
Các bạn ai có bài tập gì hay xin post lên đây nhé! Cảm ơn

 

[ptm0412]

(Mở rộng câu 5 a)
Câu 5c

Nhằm mục đích rèn luyện tư duy:
Từ 1 số N, Tô màu từng dòng từ trái qua phải, kết quả như hình (N=6):



Câu 5d

Từ 1 số N, Tô màu từng dòng từ trái qua phải, kết quả như hình (N=6):

 

[ptm0412]

Liên quan đến bẫy lỗi, ngoại trừ các phương pháp bẫy lỗi trực tiếp từng lỗi một, các lỗi còn lại nếu không lường hết hoặc không biết nên dùng thủ thuật gì, có thể dùng GoTo
Thí dụ:

Sub Tomau3()
  Dim iR As Long, iC As Long, N As Long, i As Long
  Cells.Clear
  N = Val(InputBox("Hay nhap N?"))
  If N > 128 Or N < 0 Then Msgbox "Số kỳ quá!": Exit Sub
On Error GoTo Error1
    Your Code here

Error1:
   Msgbox "Cha biet loi gi!"
   Exit Sub
End Sub

 

[MinhCong]

(Mở rộng câu 5 a)
Câu 5c

Nhằm mục đích rèn luyện tư duy:
Từ 1 số N, Tô màu từng dòng từ trái qua phải, kết quả như hình (N=6):

View attachment 51157

Câu 5d

Từ 1 số N, Tô màu từng dòng từ trái qua phải, kết quả như hình (N=6):

View attachment 51158

Em xin làm câu 5c với 2 vòng lặp như sau:

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub Tomau1()
Dim iR As Long, iC As Long, iCols As Long, iRows As Long
  Cells.Clear
  iRows = InputBox("Hay nhap so dong?")
  iCols = iRows * 2 - 1
 For iR = 1 To iRows
   For iC = iR To iCols - iR + 1
      With Cells(iR, iC)
        .Interior.ColorIndex = IIf(iR Mod 2, IIf(iC Mod 2, 3, 4), IIf(iC Mod 2, 4, 3))
        Sleep 50
      End With
    Next iC
 Next iR
End Sub

 

[ndu96081631]

Em xin làm câu 5c với 2 vòng lặp như sau:

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub Tomau1()
Dim iR As Long, iC As Long, iCols As Long, iRows As Long
  Cells.Clear
  iRows = InputBox("Hay nhap so dong?")
  iCols = iRows * 2 - 1
 For iR = 1 To iRows
   For iC = iR To iCols - iR + 1
      With Cells(iR, iC)
        .Interior.ColorIndex = IIf(iR Mod 2, IIf(iC Mod 2, 3, 4), IIf(iC Mod 2, 4, 3))
        Sleep 50
      End With
    Next iC
 Next iR
End Sub

Tiếp thu bài nhanh ghê!
Cái này: IIf(iR Mod 2, IIf(iC Mod 2, 3, 4), IIf(iC Mod 2, 4, 3))
Thay bằng cái này sẽ gọn hơn: ((iR + iC) Mod 2) + 3
-----------------------------------------------------
Cái "chóp thuận" đã làm rồi
Cái "chóp ngược" cũng đã xong
Vậy chẳng có lý do gì không làm được 5d) nhỉ?

 

[ptm0412]

IIf(iR Mod 2, IIf(iC Mod 2, 3, 4), IIf(iC Mod 2, 4, 3))

Có thể thay bằng:

IIf((iR + iC) Mod 2, 4, 3)

 

[MinhCong]

Câu 5d Em dùng 2 vòng lặp như sau:

Sub Tomau2()
Dim iR As Long, iC As Long, N As Long
Dim iCols As Long, iRows As Long, k As Long, L As Long
  Cells.Clear
  N = InputBox("Hay nhap so dong?")
  iRows = N * 2 - 1
  iCols = iRows
 For iR = 1 To iRows
 k = IIf(iR <= N, N - iR + 1, iR - N + 1)
 L = IIf(iR <= N, N + iR - 1, iCols - iR + N)
   For iC = k To L
      With Cells(iR, iC)
        .Interior.ColorIndex = IIf((iR + iC) Mod 2, 3, 4)
        Sleep 50
      End With
    Next iC
 Next iR
End Sub

 

[ptm0412]

Thật tuyệt! Nhất là ý tưởng tính K và L sau đó For từ K đến L. Thoát ra khỏi cái tư tưởng For luôn bắt đầu từ 1 hoặc bắt đầu từ 1 con số cụ thể. Nói thật, như vậy là tiến nhanh lắm đó!

Bây giờ thử chuyển cả 2 câu c và d thành 1 vòng lặp xem.

 

[ndu96081631]

Câu 5d Em dùng 2 vòng lặp như sau:

Sub Tomau2()
Dim iR As Long, iC As Long, N As Long
Dim iCols As Long, iRows As Long, k As Long, L As Long
  Cells.Clear
  N = InputBox("Hay nhap so dong?")
  iRows = N * 2 - 1
  iCols = iRows
 For iR = 1 To iRows
 k = IIf(iR <= N, N - iR + 1, iR - N + 1)
 L = IIf(iR <= N, N + iR - 1, iCols - iR + N)
   For iC = k To L
      With Cells(iR, iC)
        .Interior.ColorIndex = IIf((iR + iC) Mod 2, 3, 4)
        Sleep 50
      End With
    Next iC
 Next iR
End Sub

Thu hoạch ban đầu khả quan như vậy thật đáng chức mừng
Việc còn lại bây giờ của bạn là:
- Liên tục "cày" (không được nản)
- Liên tục cải tiến những gì đã làm (đừng tự hài lòng)
- Hãy nghĩ xem trong công việc của bạn, trước đây có file nào đó bạn từng dùng công thức, bây giờ "moi ra" liệu có thể dùng code được không? (cụ thể là dùng đến vòng lập đã học)
-----------------------
Một vài lời khuyên chân tình muốn chia sẻ đến bạn (vì tôi cũng đã từng học như bạn với sư phụ ptm0412)
Vậy nếu có ý tưởng gì hay bạn hãy gữi lên đây để chúng ta cùng bàn bạc nhé

 

[MinhCong]

Thu hoạch ban đầu khả quan như vậy thật đáng chức mừng
Việc còn lại bây giờ của bạn là:
- Liên tục "cày" (không được nản)
- Liên tục cải tiến những gì đã làm (đừng tự hài lòng)
- Hãy nghĩ xem trong công việc của bạn, trước đây có file nào đó bạn từng dùng công thức, bây giờ "moi ra" liệu có thể dùng code được không? (cụ thể là dùng đến vòng lập đã học)
-----------------------
Một vài lời khuyên chân tình muốn chia sẻ đến bạn (vì tôi cũng đã từng học như bạn với sư phụ ptm0412)
Vậy nếu có ý tưởng gì hay bạn hãy gữi lên đây để chúng ta cùng bàn bạc nhé

Cảm ơn Anh đã có lời khuyên chân tình, thật tình về VBA Em rất thích và hơn nữa có các Anh tận tình hướng dẫn, giúp đỡ nên Em thấy đây là điều kiện tốt sao Mình không học hỏi nhỉ! Việc học là vô bờ bến, biết càng nhiều càng tốt có sao đâu. Do trình độ còn yếu kém nên hôm qua đến giờ Em nghiên cứu đưa về 1 vòng lặp nhưng chưa được đấy thôi.

 

[rollover79]

Thật tuyệt! Nhất là ý tưởng tính K và L sau đó For từ K đến L. Thoát ra khỏi cái tư tưởng For luôn bắt đầu từ 1 hoặc bắt đầu từ 1 con số cụ thể. Nói thật, như vậy là tiến nhanh lắm đó!

Bây giờ thử chuyển cả 2 câu c và d thành 1 vòng lặp xem.

Để sử dụng 1 vòng lặp cho 2 câu này thì để ý 1 chút ta sẽ thấy câu c sẽ suy luận ngược với logic câu a, tương tự thì câu d sẽ là gộp của câu a và câu c, tuy nhiên logic của cả 2 câu này thì hơi phức tạp. Để dễ cho việc suy nghĩ ta nên thay vì tô màu thì hãy thử thay bằng việc gán theo số thứ tự sẽ dễ hơn. Tôi ví dụ câu c ta điền số như sau:

Khi đó ta sẽ có code như sau:

Sub test()
    Dim arrColor, iRow As Long, iCol As Long, iValue As Long, N As Long
    arrColor = Array(3, 4)
    N = InputBox("Hay nhap so dong:")
    For iValue = N ^ 2 To 1 Step -1
        iRow = N - Int(Sqr(iValue - 1))
        iCol = iRow + ((N - iRow + 1) * 2 - 1) - (iValue - (Int(Sqr(iValue - 1))) ^ 2)
        Cells(iRow, iCol) = iValue
        Cells(iRow, iCol).Interior.ColorIndex = arrColor((iRow + iCol) Mod 2)
        Sleep 100
    Next
End Sub

Với câu d thì phức tạp hơn chút nữa.

 

[ndu96081631]

Gữi bạn MinhCong và tất cả các bạn 1 trò chơi thế này

- Vẽ lên bảng tính 1 vòng tròn và đặt tên cho nó như hình



- Tạo 1 code để khi chạy thì nó sẽ quay vòng tròn này, mỗi giây quay 1 góc đúng bằng 1 khía trên mặt đồng hồ ---> Tức sau 60s thì quay đúng 1 vòng
Gợi ý:
- Để quay đúng 1 khía, ta dùng code này:

[B]Sheet1.Shapes("VT").IncrementRotation 6[/B]
[B]Sleep 1000
[COLOR=Red]DoEvents[/COLOR][/B]

(phải có DoEvents, nếu không thì sẽ chẳng thấy nó "quay" tí nào)
------------------
- Bạn đầu code chỉ cần quay 1 vòng rồi ngưng
- Sau đó bạn có thể cải tiến bằng cách: nhấn 1 nút thì quay, nhấn nút khác thì ngưng
- Có thể cải tiến tiếp: nhấn 1 nút thì quay... cũng nhấn nút đó lần nữa thì ngưng
(- Nếu khéo tay và có nhiều thời gian hơn, bạn hoàn toàn có thể làm được 3 cây kim để chạy như 1 cái đồng hồ thật sự đấy)
-----------------
Bạn thử xem ---> Tôi nghĩ rằng bạn làm được đấy

 

[MinhCong]

Quay 1 vòng rồi ngưng thì Em làm như thế này:

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub xoay()
Dim i As Integer
  For i = 1 To 60
     Sheet1.Shapes("VT").IncrementRotation 6
     Sleep 1000
     DoEvents
  Next
End Sub

 

[viehoai]

Em gửi bài tập số 5, xin các sư phụ giúp đỡ

 

[ndu96081631]

Hãy nghĩ xem người ta cho "con rắn" này uốn lượn bằng cách nào

 

[MinhCong]

Tiếp theo cho chạy cả 3 kim như sau:

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub xoay()
Dim i As Long, k As Long, j As Long
  For i = 1 To [COLOR=Red]1800000[/COLOR]
     Sheet1.Shapes("Kimgiay").IncrementRotation 6
     j = i Mod 60: k = i Mod 3600
     If j = 0 Then Sheet1.Shapes("Kimphut").IncrementRotation 6
     If k = 0 Then Sheet1.Shapes("Kimgio").IncrementRotation 6
     Sleep 1000
     DoEvents
  Next
End Sub

Không biết như thế có đúng không?
Số đến của i (1800000) để cho i chạy liên tục không dừng như đồng hồ thì thay 1800000 thành gì nhỉ?
Còn tạo nút bấm: Ta tạo 1 nút CommandButton_click trong sheet 1 luônlà bấm nó chạy được nhưng để dừng nó thì Em chưa tìm ra giải pháp:

Private Sub CommandButton1_Click()
xoay
End Sub

 

[rollover79]

Tiếp theo cho chạy cả 3 kim như sau:

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub xoay()
Dim i As Long, k As Long, j As Long
  For i = 1 To [COLOR=Red]1800000[/COLOR]
     Sheet1.Shapes("Kimgiay").IncrementRotation 6
     j = i Mod 60: k = i Mod 3600
     If j = 0 Then Sheet1.Shapes("Kimphut").IncrementRotation 6
     If k = 0 Then Sheet1.Shapes("Kimgio").IncrementRotation 6
     Sleep 1000
     DoEvents
  Next
End Sub

Không biết như thế có đúng không?
Số đến của i (1800000) để cho i chạy liên tục không dừng như đồng hồ thì thay 1800000 thành gì nhỉ?
Còn tạo nút bấm: Ta tạo 1 nút CommandButton_click trong sheet 1 luônlà bấm nó chạy được nhưng để dừng nó thì Em chưa tìm ra giải pháp:

Private Sub CommandButton1_Click()
xoay
End Sub

Bạn nên tìm hiểu thêm từ hướng dẫn của NDU về DoEvents thử xem sao, khi đó việc bấm để nó dừng thì đơn giản nhất khai báo 1 biến public kiểu boolean, trước khi chạy thì gán nó bằng true, đầu macro chạy kiểm tra nếu là false thì té, khi click vào nút dừng thì gán nó bằng false.

 

[ndu96081631]

Tiếp theo cho chạy cả 3 kim như sau:

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub xoay()
Dim i As Long, k As Long, j As Long
  For i = 1 To [COLOR=Red]1800000[/COLOR]
     Sheet1.Shapes("Kimgiay").IncrementRotation 6
     j = i Mod 60: k = i Mod 3600
     If j = 0 Then Sheet1.Shapes("Kimphut").IncrementRotation 6
     If k = 0 Then Sheet1.Shapes("Kimgio").IncrementRotation 6
     Sleep 1000
     DoEvents
  Next
End Sub

Không biết như thế có đúng không?
Số đến của i (1800000) để cho i chạy liên tục không dừng như đồng hồ thì thay 1800000 thành gì nhỉ?
Còn tạo nút bấm: Ta tạo 1 nút CommandButton_click trong sheet 1 luônlà bấm nó chạy được nhưng để dừng nó thì Em chưa tìm ra giải pháp:

Private Sub CommandButton1_Click()
xoay
End Sub

Bạn để ý thế này:
- Kim phút có tốc độ = 1 / 60 lần kim giây
- Kim giờ có tốc độ = 1 / 12 lần kim phút = 1 / 720 lần kim giây
Vậy có thể viết thế này:

With Sheet1
  .Shapes("Kimgiay").IncrementRotation 6
  .Shapes("Kimphut").IncrementRotation 1 / 10
  .Shapes("Kimgio").IncrementRotation 1 / 120
End With

Ngoài ra, do không biết vòng lập chạy từ bao nhiêu đến bao nhiêu nên ta không thể dùng For... Next mà phải Do... Loop ---> Chạy đến khi nào dừng là do ta tự quyết định
Có thể dùng 1 biến Check để kiểm tra như rollover79 vừa hướng dẫn, hoặc có thể dùng Caption của CommandButton để điều khiển ---> Khi Caption = Start thì chạy, Khi Caption = Stop thì ngưng
Kiểu vầy:

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Private Sub CommandButton1_Click()
  With Sheet1
    With .CommandButton1
      .Caption = IIf(.Caption = "Start", "Stop", "Start")
    End With
    Do
      .Shapes("Kimgiay").IncrementRotation 6
      .Shapes("Kimphut").IncrementRotation 1 / 10
      .Shapes("Kimgio").IncrementRotation 1 / 120
      Sleep 1000
      DoEvents
    Loop Until .CommandButton1.Caption = "Start"
  End With
End Sub

Chưa test ---> Bạn kiểm tra lại giúp tôi với
Code này viết cho CommandButton nha

 

[ptm0412]

1. Về 5c và 5 d của viehoai, Chạy đúng rồi. Suy luận cũng giống như Minhcong, nên xứng đáng gọi là tiến bộ.

2. Về con rắn, ẹc ẹc, sleep ít quá hay sao, nó nhảy như điên chứ đâu có gọi là uốn lượn ... Mà nhảy rồi là hông có chịu dừng, khiếp!
Gợi ý:
- Đó là chart XY scatter, y = sin(x)
- sleep 1 miếng, thay số đầu tiên của X bằng X + 1 gia số nhỏ nhỏ. Các gia trị khác của X cũng nên dùng công thức bằng giá trị X trước đó cộng với 1 số nhỏ nhỏ, để chạy theo ô đầu tiên.

3. Về cái đồng hồ:
- Code của Minhcong cũng chạy, kim giờ và phút chạy kiểu đồng hồ quart, code ndu chạy kiểu đồng hồ lên giây. (quart là khi kim giây chạy đủ 1 vòng, kim phút nhảy 1 cái kịch. Lên giây là kim phút cũng có di chuyển từng chút một xem như liên tục)
- Tuy nhiên, code Minh Công chưa xét đến chuyện i Mod 60 =0 ở vị trí khởi đầu bất kỳ, nên kim phút nhảy cái kịch khi kim giây ở vị trí khác số 12 của đồng hồ. Để giải quyết có thể dùng 1 đoạn code chạy đầu tiên, đoạn code này lấy giờ hiện tại, xoay cả 3 kim đến vị trí đúng của nó rồi mới bắt đầu chạy. Ngoài ra, điều kiện để kim phút và kim giờ "nhảy cái kịch" cũng phải sửa lại.

Thí dụ:

Sub Gettime()
Dim Ctime As Double, hr As Long, mt As Long, sd As Long
Ctime = Time
hr = Hour(Ctime) Mod 12
mt = Minute(Ctime)
sd = Second(Ctime)
With Sheet1
    .Shapes("Kimgio").Rotation = hr * 30
    .Shapes("Kimphut").Rotation = mt * 6
    .Shapes("Kimgiay").Rotation = sd * 6
End With
End Sub

Ghi chú: Code mẫu này lấy giờ cho kim đồng hồ chạy kiểu Quart. Lấy vị trí cho kim chạy kiểu lên giây cần chính xác hơn nữa.

 

[rollover79]

Về cách tạo đồng hồ các bạn có thể tham khảo thêm tại đây.

 

[boyxin]

Hãy nghĩ xem người ta cho "con rắn" này uốn lượn bằng cách nào

Thật là hay hay hay (nghịch file của ndu96081631 tý xíu nhé)​

 

[viehoai]

Hãy nghĩ xem người ta cho "con rắn" này uốn lượn bằng cách nào

View attachment 51226

Em xin đưa file lên xin các sư phụ chấm điểm

 

[ptm0412]

Sao viehoai thay số vào B1? thay vào A1, và B1 vẫn = Sin(A1) chứ?
Viehoai thử nghiên cứu vòng lặp Do Loop chạy - dừng xem.
Và thử thay A2 = A1 + số khác >1 thay cho +1, con rắn hiện giờ đang chạy từ phải qua trái, không phải uốn lượn.

 

[viehoai]

Sao viehoai thay số vào B1? thay vào A1, và B1 vẫn = Sin(A1) chứ?
Viehoai thử nghiên cứu vòng lặp Do Loop chạy - dừng xem.
Và thử thay A2 = A1 + số khác >1 thay cho +1, con rắn hiện giờ đang chạy từ phải qua trái, không phải uốn lượn.

Làm theo ý sư phụ, xin sư phụ giúp tiếp
Nhờ sơ phụ xem sao em bỏ đường ngang không được nhỉ?
Em xin cảm ơn

 

[MinhCong]

Làm theo ý sư phụ, xin sư phụ giúp tiếp
Nhờ sơ phụ xem sao em bỏ đường ngang không được nhỉ?
Em xin cảm ơn

Con rắn chạy từ trái sang phải không phải uốn lượn.
Bạn xem do loop ở Bài trên của Anh NDU hướng dẫn về cái đồng hồ và bấm nút dừng chạy ấy.
Cái đường ngang-> Bạn bấm vào nó bấm phải chuột -> Clear là ok thôi.

 

[ptm0412]

Click chọn cái đường ngang (gridline), nhấn delete là xong mà, nếu không thì vào Chart option, click bỏ chọn major gridline.
Sao không kéo công thức A2 xuống luôn, đẹp lắm. Vì không kéocông thức nên con rắn cũng chỉ chạy ngang.

với 1 commandbutton mà muốn nhấn 1 cái chạy, nhấn cái nữa dừng thì trước tiên chỉnh caption của nút thành Start, sau đó dùng:

Private Sub CommandButton1_Click()
With CommandButton1
.Caption = IIf(.Caption = "Start", "Stop", "Start")

  Do
      Range("A1").Value = Range("A1").Value + 0.1
       Sleep 30
      DoEvents
  Loop Until .Caption = "Start"
End With
  Range("A1").Value = 1
End Sub

 

[ndu96081631]

Về cách tạo đồng hồ các bạn có thể tham khảo thêm tại đây.

Mấy cái đồng hồ đó vấn chưa đạt CHUẨN đâu ---> CHUẨN tức là đồng hồ chạy mà không ảnh hưởng gì đến công việc của ta và ngược lại, việc ta làm cũng không ảnh hưởng đến đồng hồ
Thật ra là dùng đồng hồ để nghiên cứu vòng lập thôi
Chứ cái đồng hồ thật sự nó phải thế này:

Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Sub StartTimer()
  StopTimer
  SetTimer Application.hWnd, 1, 1000, AddressOf TimeProc
End Sub

Sub StopTimer()
  KillTimer Application.hWnd, 1
End Sub

Private Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long)
  Dim sTotal As Double, hPos As Double, mPos As Double, sPos As Double
  On Error Resume Next
  sTotal = Hour(Time) * 3600 + Minute(Time) * 60 + Second(Time)
  sPos = (sTotal Mod 60) * 6
  mPos = ((sTotal / 60) Mod 60) * 6
  hPos = ((sTotal / 720) Mod 60) * 6
  With Sheet2
    .Shapes("sec").Rotation = sPos
    .Shapes("min").Rotation = mPos
    .Shapes("hrs").Rotation = hPos
  End With
End Function

------------
Nếu viết để học vòng lập thì cũng gần giống code trên

Private Sub CommandButton1_Click()
  Dim sTotal As Double, hPos As Double, mPos As Double, sPos As Double
  With Sheet1
    With .CommandButton1
      .Caption = IIf(.Caption = "Start", "Stop", "Start")
    End With
    Do
      sTotal = Hour(Time) * 3600 + Minute(Time) * 60 + Second(Time)
      sPos = (sTotal Mod 60) * 6
      mPos = ((sTotal / 60) Mod 60) * 6
      hPos = ((sTotal / 720) Mod 60) * 6
      .Shapes("sec").Rotation = sPos
      .Shapes("min").Rotation = mPos
      .Shapes("hrs").Rotation = hPos
      Sleep 1000
      DoEvents
    Loop Until .CommandButton1.Caption = "Start"
  End With
End Sub

Cũng như tôi đã nói ở trên: HỌC LÀ CHÍNH... chứ xây dựng động hồ mà dùng Sleep thì có mà... chết luôn!

 

[ptm0412]

Cũng như tôi đã nói ở trên: HỌC LÀ CHÍNH... chứ xây dựng động hồ mà dùng Sleep thì có mà... chết luôn!

Chính xác. Sleep 1 giây là giữa 2 lần lặp, mỗi lần lặp là chạy 1 số câu lệnh, thì bị cách 1 quãng thời gian chạy các dòng lệnh đó. Thí dụ chạy 3 dòng lệnh mất 0.01 giây, vậy 1 vòng lặp là 1.01 giây, đồng hồ không chính xác. Với 1 máy yếu hơn, chạy chậm hơn, thì càng không chính xác.

Đồng hồ chạy chín hxác là đồng hồ lấy thời gian từ hệ thống. lặp cũng được.

 

[ndu96081631]

Chính xác. Sleep 1 giây là giữa 2 lần lặp, mỗi lần lặp là chạy 1 số câu lệnh, thì bị cách 1 quãng thời gian chạy các dòng lệnh đó. Thí dụ chạy 3 dòng lệnh mất 0.01 giây, vậy 1 vòng lặp là 1.01 giây, đồng hồ không chính xác. Với 1 máy yếu hơn, chạy chậm hơn, thì càng không chính xác.

Đồng hồ chạy chín hxác là đồng hồ lấy thời gian từ hệ thống. lặp cũng được.

Quan trọng ở đây là khi nó chạy thì chẳng làm được giống gì cả, đã vậy còn chạy rất.. nặng nề

 

[ptm0412]

Về đồng hồ, có thể tham khảo đồng hồ trong topic thi vẽ biểu đồ chào mừng SN 3, bổ sung đồng hồ có quả lắc.

Còn con rắn, nếu nghịch thì nghịch tới nơi tới chốn, khà khà. Tải file và chạy thử, con rắn lúc thì uốn lượn nhịp nhàng, lúc thì nhảy cà tưng, dzui lắm.

 

[ndu96081631]

Về đồng hồ, có thể tham khảo đồng hồ trong topic thi vẽ biểu đồ chào mừng SN 3, bổ sung đồng hồ có quả lắc.

Còn con rắn, nếu nghịch thì nghịch tới nơi tới chốn, khà khà. Tải file và chạy thử, con rắn lúc thì uốn lượn nhịp nhàng, lúc thì nhảy cà tưng, dzui lắm.

Ẹc... Ẹc.... về phần biểu đồ thì chẳng ai địch nổi sư phụ... vì vậy mà em thà dùng API cho nó khoẻ! (code ngắn gọn, chạy chính xác và hoàn toàn không ảnh hướng đến bất kỳ công việc nào trên bảng tính)

 

[ptm0412]

Bài 5 a, c, và d với 1 vòng lặp

Suy luận đơn giản: iRow cố định và jCol tăng 1, Khi thoả điều kiện thì iRow tăng 1 (xuống dòng) và tính lại jCol xuất phát của dòng mới.
Do đơn giản, nên có thể áp dụng và mở rộng 2 điều kiện a và c, gộp lại thành d

Private Sub To5a()
Dim iRow As Long, jCol As Long, N As Long, t As Long
Cells.Clear
N = InputBox("Cho so N")
iRow = 1: jCol = N - iRow + 1
For t = 1 To N ^ 2
    Cells(iRow, jCol).Interior.ColorIndex = IIf((iRow + jCol) Mod 2 = 0, 15, 16)
    Sleep 10
    jCol = jCol + 1
    If t = iRow ^ 2 Then iRow = iRow + 1: jCol = N - iRow + 1
Next
End Sub

Private Sub To5c()
Dim iRow As Long, jCol As Long, N As Long, t As Long
Cells.Clear
N = InputBox("Cho so N")
iRow = 1: jCol = 1
For t = 1 To N ^ 2
    Cells(iRow, jCol).Interior.ColorIndex = IIf((iRow + jCol) Mod 2 = 0, 15, 16)
    Sleep 10
    jCol = jCol + 1
    If t = N ^ 2 - (N - iRow) ^ 2 Then iRow = iRow + 1: jCol = iRow
Next
End Sub

Private Sub To5d()
Dim iRow As Long, jCol As Long, N As Long, t As Long, tCount As Long
Cells.Clear
N = InputBox("Cho so N")
iRow = 1
jCol = N - iRow + 1
tCount = N ^ 2 + (N - 1) ^ 2
For t = 1 To tCount
    Cells(iRow, jCol).Interior.ColorIndex = IIf((iRow + jCol) Mod 2 = 0, 15, 16)
    Sleep 10
    jCol = jCol + 1
    If iRow < N And t = iRow ^ 2 Then iRow = iRow + 1: jCol = N - iRow + 1
    If iRow >= N And t = tCount - (2 * N - 1 - iRow) ^ 2 Then iRow = iRow + 1: jCol = iRow - N + 1
Next
End Sub

 

[viehoai]

Sao không thấy các sự phụ ra bài tập cho những ngày Lễ ???

 

[ptm0412]

Bài 6

Trong tập hợp các số có 6 chữ số (từ 100.000 đến 999.999):

a. Đếm và liệt kê các số có 3 chữ số giống nhau lên bảng tính, (2, 4, 5, 6 số giống nhau là không tính). 3 chữ số giống nhau này nằm ở vị trí bất kỳ, thí dụ 333456, 345633, 334563, 433356, 343536, ...333645, ...

b. Cố gắng giảm thiểu số vòng lặp, nên có 1 biến đếm số lần lặp để so sánh với số kết quả.

c. Nếu có thể, sử dụng mảng để tăng tốc độ.

 

[MinhCong]

Bài 6

Trong tập hợp các số có 6 chữ số (từ 100.000 đến 999.999):

a. Đếm và liệt kê các số có 3 chữ số giống nhau lên bảng tính, (2, 4, 5, 6 số giống nhau là không tính). 3 chữ số giống nhau này nằm ở vị trí bất kỳ, thí dụ 333456, 345633, 334563, 433356, 343536, ...333645, ...

b. Cố gắng giảm thiểu số vòng lặp, nên có 1 biến đếm số lần lặp để so sánh với số kết quả.

c. Nếu có thể, sử dụng mảng để tăng tốc độ.

Em xin dùng 2 vòng lặp For như sau. Các Anh xem và góp ý cho Em nhé!

Sub Lietke()
Dim i As Long, j As Integer, demso As Long, k As Long
Cells.Clear
For i = 100000 To 999999
    For j = 0 To 9
        If j = 2 Or j = 4 Or j = 5 Or j = 6 Then Exit For
        With Cells(k + 1, 1)
            If Len(Replace(i, j, "")) = 3 Then
                .Value = i
                demso = demso + 1
                k = k + 1
                Exit For
            End If
        End With
    Next j
Next i
MsgBox "So luong cac so co 3 chu so giong nhau la: " & demso
End Sub

Chỗ vòng lặp For j=0 to 9 Em muốn dùng for each j in arr(0,1,3,7,8,9) thì phải khia bảo như thế nào nhỉ? (Mục đích để khỏi phải dùng if ở dòng lệnh tiếp theo)

 

[ndu96081631]

Em xin dùng 2 vòng lặp For như sau:

Sub Lietke()
Dim i As Long, j As Integer, demso As Long, k As Long
Cells.Clear
For i = 100000 To 999999
    For j = 0 To 9
        If j = 2 Or j = 4 Or j = 5 Or j = 6 Then Exit For
        With Cells(k + 1, 1)
            If Len(Replace(i, j, "")) = 3 Then
                .Value = i
                demso = demso + 1
                k = k + 1
                Exit For
            End If
        End With
    Next j
Next i
MsgBox "So luong cac so co 3 chu so giong nhau la: " & demso
End Sub

Chỗ vòng lặp For j=0 to 9 Em muốn dùng for each j in arr(0,1,3,7,8,9) thì phải khia bảo như thế nào nhỉ? (Mục đích để khỏi phải dùng if ở dòng lệnh tiếp theo)

Thì tạo 1 biến Arr
Arr = Array(0,1,3,7,8,9)
Rồi
For Each j in Arr
Có điều tôi chưa hiểu tại sao bạn lại bỏ qua mấy số 2, 4, 5 và 6 nhỉ?

 

[MinhCong]

À em hiểu chỗ 2, 4, 5, 6 giiống nhau như thế nào rồi, Em tưởng không tính nó chứ.

 

[ndu96081631]

À em hiểu chỗ 2, 4, 5, 6 giiống nhau như thế nào rồi, Em tưởng không tính nó chứ.

Bài này mà dùng Excel 2003 thì không ăn rồi ---> Kết quả đến trên 130,000 số ---> Làm sao liệt kê?
Sửa lại bài toán trên: Duyệt từ số 100000 đến 500000 thôi

 

[MinhCong]

Bài này mà dùng Excel 2003 thì không ăn rồi ---> Kết quả đến trên 130,000 số ---> Làm sao liệt kê?
Sửa lại bài toán trên: Duyệt từ số 100000 đến 500000 thôi

Em sửa lại 1 tí với 2 vòng lặp như sau:

Sub Lietke()
Dim i As Long, j As Integer, demso As Long
Cells.Clear
For i = 100000 To 500000
    For j = 0 To 9
        With Cells(demso + 1, 1)
            If Len(Replace(i, j, "")) = 3 Then
                .Value = i
                demso = demso + 1
                Exit For
            End If
        End With
    Next j
Next i
MsgBox "So luong cac so co 3 chu so giong nhau la: " & demso
End Sub

Chưa nghĩ ra phương án nào khác nữa, Em sẽ cố nghiên cứu tiếp.

 

[ndu96081631]

Em sửa lại 1 tí với 2 vòng lặp như sau:

Sub Lietke()
Dim i As Long, j As Integer, demso As Long
Cells.Clear
For i = 100000 To 500000
    For j = 0 To 9
        With Cells(demso + 1, 1)
            If Len(Replace(i, j, "")) = 3 Then
                .Value = i
                demso = demso + 1
                Exit For
            End If
        End With
    Next j
Next i
MsgBox "So luong cac so co 3 chu so giong nhau la: " & demso
End Sub

Chưa nghĩ ra phương án nào khác nữa, Em sẽ cố nghiên cứu tiếp.

Góp ý chút
Ngay chổ For j = 0 To 9 tức là duyệt từ 0 đến 9, mục đích xem có số nào nằm ở 3 vị trí không ---> Vị chi vòng lập này chạy 10 lần, đúng không?
Nếu bạn duyệt qua các ký tự của số thì chỉ tốn có 6 lần lập thôi

 

[MinhCong]

Góp ý chút
Ngay chổ For j = 0 To 9 tức là duyệt từ 0 đến 9, mục đích xem có số nào nằm ở 3 vị trí không ---> Vị chi vòng lập này chạy 10 lần, đúng không?
Nếu bạn duyệt qua các ký tự của số thì chỉ tốn có 6 lần lập thôi

Em làm theo chỉ dẫn của Anh theo Em nghĩ là chỉ cần 4 vòng lặp cho j thôi.

Sub Lietke()
Dim i As Long, j As Integer, demso As Long
Cells.Clear
For i = 100000 To 500000
    For j = 1 To 4
        With Cells(demso + 1, 1)
            If Len(Replace(i, Mid$(i, j, 1), "")) = 3 Then
                .Value = i
                demso = demso + 1
                Exit For
            End If
        End With
    Next j
Next i
MsgBox "So luong cac so co 3 chu so giong nhau la: " & demso
End Sub

 

[ndu96081631]

Khá lắm!
Nghĩ ra được For j = 1 to 4 là trình độ suy luận của bạn của đã nâng cao nhiều lắm rồi đấy
Giờ chỉ còn công đoạn nữa là đưa mọi thứ tìm được vào mảng (thay vì điền kết quả trực tiếp vào cell) ---> Như vậy tốc độ sẽ nhanh hơn

 

[viehoai]

Bài 6

Trong tập hợp các số có 6 chữ số (từ 100.000 đến 999.999):

a. Đếm và liệt kê các số có 3 chữ số giống nhau lên bảng tính, (2, 4, 5, 6 số giống nhau là không tính). 3 chữ số giống nhau này nằm ở vị trí bất kỳ, thí dụ 333456, 345633, 334563, 433356, 343536, ...333645, ...
b. Cố gắng giảm thiểu số vòng lặp, nên có 1 biến đếm số lần lặp để so sánh với số kết quả.
c. Nếu có thể, sử dụng mảng để tăng tốc độ.

Sư phụ ơi đúng là một bài tập khó thật, hay là sư phụ cho các đệ đau đầu khỏi chơi Lễ luôn? he he vui với sư phụ vậy thôi
Em sẽ cố gắng, về mãng em chưa biết và chưa được nghiên cứu, như vầy sẽ tốt cho em. Cảm ơn các sư phụ

 

[ptm0412]

Góp ý về thuật toán:
Code của minhCong sau vài lần cải tiến, cũng chỉ là 1 thuật toán. Duyệt qua tất cả các số (400.001 số), dò 4 lần (code sau cùng), nhân lên là 1.600.004 lần VBA đánh vật với các con số. Nhờ câu exit For, số lần lặp giảm còn 1.469.324.
Nếu cải tiến tốt hơn nữa, là dùng Aray, cũng vẫn là thuật toán cũ, coi như, chỉ đạt câu 6a.

Hãy làm sao, suy luận theo hướng khác, giảm được số lần lặp?

 

[ndu96081631]

Góp ý về thuật toán:
Code của minhCong sau vài lần cải tiến, cũng chỉ là 1 thuật toán. Duyệt qua tất cả các số (400.001 số), dò 4 lần (code sau cùng), nhân lên là 1.600.004 lần VBA đánh vật với các con số. Nhờ câu exit For, số lần lặp giảm còn 1.469.324.
Nếu cải tiến tốt hơn nữa, là dùng Aray, cũng vẫn là thuật toán cũ, coi như, chỉ đạt câu 6a.

Hãy làm sao, suy luận theo hướng khác, giảm được số lần lặp?

Em nghĩ làm được như MinhCong là quá đạt yêu cầu rồi, ít nhất là yêu câu của topic này (dành cho người mới học) ---> Cao cấp hơn nữa về thuật toán nên bàn ở 1 topic khác thì hơn
(ngợp quá người ta chạy hết)

 

[ptm0412]

Để có thể chạy từ 100.000 đến 999.999 trong 2003, ta sẽ chia thành từng cụm 10.000 số hoặc 20.000 số như sau:

Dùng 1 biến dòng, tăng dần, nếu = 10.000 thì quay về 1
Dùng 1 biến cột, nếu dòng = 1 thì tăng cột lên 1.

Dim iRow As Long, iCol As Long
iRow = IIf(iRow = 10000, 1, iRow +1)
iCol = IIf(iRow = 1, iCol +1, iCol)
Cells(iRow, iCol) = ...

 

[MinhCong]

Góp ý về thuật toán:
Code của minhCong sau vài lần cải tiến, cũng chỉ là 1 thuật toán. Duyệt qua tất cả các số (400.001 số), dò 4 lần (code sau cùng), nhân lên là 1.600.004 lần VBA đánh vật với các con số. Nhờ câu exit For, số lần lặp giảm còn 1.469.324.
Nếu cải tiến tốt hơn nữa, là dùng Aray, cũng vẫn là thuật toán cũ, coi như, chỉ đạt câu 6a.

Hãy làm sao, suy luận theo hướng khác, giảm được số lần lặp?

Theo Em nghĩ nếu có thể giảm số vòng lặp xuống bằng cách cho i chạy giảm xuống thay vì từ i=100000 to 500000 giảm xuống còn i=100000 to 200000 và kết quả đếm số sẽ nhân thêm 4 nữa là được. Tuy nhiên để ghi kết quả ra thì phải thêm 1thuật toán nữa, không biết có được không nhỉ?

 

[ptm0412]

gợi ý vầy:
Thay vì duyệt qua tất cả các số, ta tìm quy luật số rồi liệt kê ra. Thí dụ:
1.- Cho 3 số giống nhau, chẳng hạn 000, 3 số còn lại mỗi số từ 1 đến 9, vậy thay từ từ vào 3 số còn lại, thay đến đâu, ghi lại đến đó. (Ghi xuống sheet hoặc ghi vào mảng)
2.- Tìm tất cả vị trí có thể của 3 số 000. Lặp lại bước 1.
3.- Thay 3 số 000 bằng 111, 3 số còn lại là 0 và từ 2 đến 9. Lặp lại bước 1 và 2.

Theo thuật toán này thì có bao nhiêu số thoả điều kiện, sẽ chạy đúng bấy nhiêu vòng lặp. Code chắc chắn là dài hơn, nhưng chạy nhanh hơn.

Suy luận là thế (thuật toán hoặc giải thuật), còn thủ thuật, là dùng mấy vòng For, bao nhiêu điều kiện, bao nhiêu trường hợp, ... thì nghĩ thêm.

 

[boyxin]

Bài 6

Trong tập hợp các số có 6 chữ số (từ 100.000 đến 999.999):

a. Đếm và liệt kê các số có 3 chữ số giống nhau lên bảng tính, (2, 4, 5, 6 chữ số giống nhau là không tính). 3 chữ số giống nhau này nằm ở vị trí bất kỳ, thí dụ 333456, 345633, 334563, 433356, 343536, ...333645, ...

b. Cố gắng giảm thiểu số vòng lặp, nên có 1 biến đếm số lần lặp để so sánh với số kết quả.

c. Nếu có thể, sử dụng mảng để tăng tốc độ.

Em xin hỏi chút:

1) Số có tới 2 cặp 3 chữ số giống nhau
VD: 100011; 111222; ... có được tính không?

2) Số có 3 chữ số giống nhau nhưng lại có 2 chữ số khác cũng giống nhau
VD: 100012, 100022, ... có được tính không?

 

[ndu96081631]

Em xin hỏi chút:

1) Số có tới 2 cặp 3 chữ số giống nhau
VD: 100011; 111222; ... có được tính không?

2) Số có 3 chữ số giống nhau nhưng lại có 2 chữ số khác cũng giống nhau
VD: 100012, 100022, ... có được tính không?

Tính luôn bạn à! Miễn sao tìm thấy 3 ông giống nhau (nằm ở bất cứ vị trí nào) là được rồi
--------------------------------------

gợi ý vầy:
Thay vì duyệt qua tất cả các số, ta tìm quy luật số rồi liệt kê ra. Thí dụ:
1.- Cho 3 số giống nhau, chẳng hạn 000, 3 số còn lại mỗi số từ 1 đến 9, vậy thay từ từ vào 3 số còn lại, thay đến đâu, ghi lại đến đó. (Ghi xuống sheet hoặc ghi vào mảng)
2.- Tìm tất cả vị trí có thể của 3 số 000. Lặp lại bước 1.
3.- Thay 3 số 000 bằng 111, 3 số còn lại là 0 và từ 2 đến 9. Lặp lại bước 1 và 2.
.

Dùng cách này chẳng dễ ăn đâu nha!
Ví dụ:
- Cho trước số 000
- Cho thêm số 442 rồi hoán vị 3 chữ số này với 3 chữ số của số 000
- Trong các kết quả tìm được, chắc chắc có số 442000
- Giờ đổi số 442 thành 244 rồi hoán vị với 000 ---> Trong các kết quả tìm được chắc chắn cũng sẽ có số 442000
===> Nội chuyện loại ra các giá trị trùng cũng đủ mệt rồi ---> Chẳng lẽ phải dùng Dictionary Object?

 

[ptm0412]

Ví dụ:
- Cho trước số 000
- Cho thêm số 442 rồi hoán vị 3 chữ số này với 3 chữ số của số 000
- Trong các kết quả tìm được, chắc chắc có số 442000
- Giờ đổi số 442 thành 244 rồi hoán vị với 000 ---> Trong các kết quả tìm được chắc chắn cũng sẽ có số 442000
===> Nội chuyện loại ra các giá trị trùng cũng đủ mệt rồi ---> Chẳng lẽ phải dùng Dictionary Object?

Nếu thay từ từ từng chữ số một thì không bị trùng kiểu 442000 nhiều lần

Thí dụ với 3 số 111, vị trí 3 số nằm đầu, dạng 111xyz:

Sub abc()
a = 1: b = 1: c = 1
Arr1 = Array(0, 2, 3, 4, 5, 6, 7, 8, 9)
For Each A1 In Arr1
    For Each A2 In Arr1
       For Each A3 In Arr1
          l = l + 1
          Cells(l, 1) = a & a & a & A1 & A2 & A3
Next A3, A2, A1
End Sub

Chỉ còn trùng dạng 111222, 111333, ...
Và chỉ cần thêm điều kiện:

If A1 = A2 and A2 = A3 Then Exit For

 

[boyxin]

Em làm theo chỉ dẫn của Anh theo Em nghĩ là chỉ cần 4 vòng lặp cho j thôi.

Sub Lietke()
Dim i As Long, j As Integer, demso As Long
Cells.Clear
For i = 100000 To 500000
    For j = 1 To 4
        With Cells(demso + 1, 1)
            If Len(Replace(i, Mid$(i, j, 1), "")) = 3 Then
                .Value = i
                demso = demso + 1
                Exit For
            End If
        End With
    Next j
Next i
MsgBox "So luong cac so co 3 chu so giong nhau la: " & demso
End Sub

Sửa chút xíu như sau, thời gian giảm xuống đáng kể (thông số test trên máy của boyxin trong file đính kèm)

Sub Lietke3()
Dim Tmp, t, i As Long, j As Byte, ic As Byte, ir As Long
    t = Timer
    [a1].CurrentRegion.ClearContents
    Tmp = [a1].Resize(15000, 4).Value
For i = 100000 To 499999
    ic = Int(i / 100000)
    For j = 1 To 4
        If Len(Replace(i, Mid$(i, j, 1), "")) = 3 Then
            ir = IIf(ir >= 14490, 1, ir + 1)
            Tmp(ir, ic) = i: Exit For
End If: Next: Next
[a1].Resize(ir, 4) = Tmp: [n1] = Timer - t
End Sub

 

[ndu96081631]

Bài tập mới

Nhân tiện có bài viết này:
http://www.giaiphapexcel.com/forum/showthread.php?39955-Giúp-mình-cách-đánh-dấu-giữa-các-chữ-số-với
Vậy chúng ta cùng làm 1 bài tập mới như sau:
Tạo 1 Function để tách 1 chuổi ra thành nhiều nhóm. Số lượng ký tự trong mỗi nhóm do ta định nghĩa và mỗi nhóm cách nhau bởi 1 dấu phân cách nào đó cũng do ta định nghĩa
Ví dụ:

Function Tach(Chuoi as String, Nhom as Long, PC  as String) as String
...
End Function

Với chuổi aaaaa thì hàm Tach("aaaaa", 3, "-") sẽ cho kết quả = aaa-aa
Với chuổi aaaaa thì hàm Tach("aaaaa", 2, "-") sẽ cho kết quả = aa-aa-a
---------------
Bài này không khó nhưng hơi rối 1 chút

 

[MinhCong]

Nhân tiện có bài viết này:
http://www.giaiphapexcel.com/forum/showthread.php?39955-Giúp-mình-cách-đánh-dấu-giữa-các-chữ-số-với
Vậy chúng ta cùng làm 1 bài tập mới như sau:
Tạo 1 Function để tách 1 chuổi ra thành nhiều nhóm. Số lượng ký tự trong mỗi nhóm do ta định nghĩa và mỗi nhóm cách nhau bởi 1 dấu phân cách nào đó cũng do ta định nghĩa
Ví dụ:

Function Tach(Chuoi as String, Nhom as Long, PC  as String) as String
...
End Function

Với chuổi aaaaa thì hàm Tach("aaaaa", 3, "-") sẽ cho kết quả = aaa-aa
Với chuổi aaaaa thì hàm Tach("aaaaa", 2, "-") sẽ cho kết quả = aa-aa-a
---------------
Bài này không khó nhưng hơi rối 1 chút

Hè hè, Bài đó Anh đã làm rồi còn gì, chỉ cần thay lại Nhóm và PC là được thôi mà.

Function Tach(Chuoi As String, Nhom As Long, PC As String) As String
  Dim i As Long, j As Long
    On Error Resume Next
      Chuoi = Replace(Chuoi, " ", "")
       j = (Len(Chuoi) - 1) Mod Nhom
          For i = Len(Chuoi) - j To 1 Step -Nhom
              Tach = Mid(Chuoi, i, Nhom) & " " & Tach
          Next
  Tach = Replace(Trim(Tach), " ", PC)
End Function

 

[concogia]

Nhân tiện có bài viết này:
http://www.giaiphapexcel.com/forum/showthread.php?39955-Giúp-mình-cách-đánh-dấu-giữa-các-chữ-số-với
Vậy chúng ta cùng làm 1 bài tập mới như sau:
Tạo 1 Function để tách 1 chuổi ra thành nhiều nhóm. Số lượng ký tự trong mỗi nhóm do ta định nghĩa và mỗi nhóm cách nhau bởi 1 dấu phân cách nào đó cũng do ta định nghĩa
Ví dụ:

Function Tach(Chuoi as String, Nhom as Long, PC as String) as String
...
End Function

Với chuổi aaaaa thì hàm Tach("aaaaa", 3, "-") sẽ cho kết quả = aaa-aa
Với chuổi aaaaa thì hàm Tach("aaaaa", 2, "-") sẽ cho kết quả = aa-aa-a
---------------
Bài này không khó nhưng hơi rối 1 chút

Bài này mình thấy nó y chang mấy bài vừa làm mà Thầy, nó chỉ mang tính tổng quát thôi

Public Function cungzi(Vung As String, Dk As Integer, Dau As String) As String
    Dim i As Integer, Tam As String, j As String
            For i = 1 To Len(Vung)
                    j = Mid(Vung, i, 1)
                If i Mod Dk = 0 Then
                    Tam = Tam & j & Dau
                Else
                    Tam = Tam & j
                End If
            Next
    If Len(Vung) Mod Dk = 0 Then
        cungzi = Left(Tam, Len(Tam) - 1)
    Else
        cungzi = Tam
    End If
End Function

Nếu số ký tự tách (Vung) ít hơn điều kiện tách (Dk) thì sao?
Híc, đề này dễ.... eeeccctttttt

 

[MinhCong]

Bài này mình thấy nó y chang mấy bài vừa làm mà Thầy, nó chỉ mang tính tổng quát thôi

Public Function cungzi(Vung As String, Dk As Integer, Dau As String) As String
    Dim i As Integer, Tam As String, j As String
            For i = 1 To Len(Vung)
                    j = Mid(Vung, i, 1)
                If i Mod Dk = 0 Then
                    Tam = Tam & j & Dau
                Else
                    Tam = Tam & j
                End If
            Next
    If Len(Vung) Mod Dk = 0 Then
        cungzi = Left(Tam, Len(Tam) - 1)
    Else
        cungzi = Tam
    End If
End Function

Nếu số ký tự tách (Vung) ít hơn điều kiện tách (Dk) thì sao?
Híc, đề này dễ.... eeeccctttttt

Theo Em nghĩ thêm 1 điều kiện IF nữa để tránh trường hợp Nhóm<=0 hoặc Nhóm>Len(Chuoi) là được.

Function Tach(Chuoi As String, Nhom As Long, PC As String) As String
  Dim i As Long, j As Long
    On Error Resume Next
      Chuoi = Replace(Chuoi, " ", "")
    If Nhom <= 0 Or Nhom > Len(Chuoi) Then
       Tach = Chuoi
    Else
       j = (Len(Chuoi) - 1) Mod Nhom
          For i = Len(Chuoi) - j To 1 Step -Nhom
             Tach = Mid(Chuoi, i, Nhom) & " " & Tach
          Next
     Tach = Replace(Trim(Tach), " ", PC)
     End If
End Function

Không biết có bị tèo hay không nhỉ?

 

[ndu96081631]

Bài này mình thấy nó y chang mấy bài vừa làm mà Thầy, nó chỉ mang tính tổng quát thôi

Vấn đề là code càng ngắn càng tốt ---> Em thấy code của anh IF nhiều quá đi mất
------------------------

Theo Em nghĩ thêm 1 điều kiện IF nữa để tránh trường hợp Nhóm<=0 hoặc Nhóm>Len(Chuoi) là được.

Nếu Nhom < 0 tức là ta cố tình "phá" rồi còn gì ---> MS cũng không thể nào lường nổi mấy vụ này
Đàng nào thì cũng đã có On Error Resume Next rồi còn gì
Nếu Nhom > Len(Chuoi) ---> Vụ này chẳng có vấn đề gì
------------------------
Bài này tôi nghĩ quét thuận sẽ dễ hơn đấy
Nếu code này thì sao?

  Chuoi = Replace(Chuoi, " ", "")
  j = Int(Len(Chuoi) / Nhom) + ((Len(Chuoi) Mod Nhom) = 0)
  For i = 0 To j
  ......

Thử làm bài này mà không có IF nào hết xem!

 

[concogia]

Vấn đề là code càng ngắn càng tốt ---> Em thấy code của anh IF nhiều quá đi mất
------------------------

Nếu Nhom < 0 tức là ta cố tình "phá" rồi còn gì ---> MS cũng không thể nào lường nổi mấy vụ này
Đàng nào thì cũng đã có On Error Resume Next rồi còn gì
Nếu Nhom > Len(Chuoi) ---> Vụ này chẳng có vấn đề gì
------------------------
Bài này tôi nghĩ quét thuận sẽ dễ hơn đấy
Nếu code này thì sao?

Chuoi = Replace(Chuoi, " ", "")
j = Int(Len(Chuoi) / Nhom) + ((Len(Chuoi) Mod Nhom) = 0)
For i = 0 To j
......

Thử làm bài này mà không có IF nào hết xem!

Cái này không có IF

Public Function tachhoai(Vung As Range, Dk As Integer, Dau As String) As String
    Dim Thay As String, Tam As String, I As Integer
        For I = 1 To Len(Vung) Step Dk
            Thay = Dau & Mid(Vung, I, Dk)
            Tam = Tam & Thay
        Next
    tachhoai = Right(Tam, Len(Tam) - 1)
End Function

 

[rollover79]

Vấn đề là code càng ngắn càng tốt ---> Em thấy code của anh IF nhiều quá đi mất
------------------------

Nếu Nhom < 0 tức là ta cố tình "phá" rồi còn gì ---> MS cũng không thể nào lường nổi mấy vụ này
Đàng nào thì cũng đã có On Error Resume Next rồi còn gì
Nếu Nhom > Len(Chuoi) ---> Vụ này chẳng có vấn đề gì
------------------------
Bài này tôi nghĩ quét thuận sẽ dễ hơn đấy
Nếu code này thì sao?

  Chuoi = Replace(Chuoi, " ", "")
  j = Int(Len(Chuoi) / Nhom) + ((Len(Chuoi) Mod Nhom) = 0)
  For i = 0 To j
  ......

Thử làm bài này mà không có IF nào hết xem!

Về cơ bản bài này mọi người đã giải quyết xong rồi, xin góp vui 1 code như sau, không có IF và không có vòng lặp luôn

Function test(str As String, iNumber As Integer, sSplit As String) As String
    On Error Resume Next
    str = str & String(WorksheetFunction.Ceiling(Len(str), iNumber) - Len(str), vbBack)
    test = Replace(Join(Evaluate("TRANSPOSE(MID(""" & str & """,(ROW(1:" & Len(str) \ iNumber & ")-1)*" & iNumber & "+1," & iNumber & "))"), sSplit), vbBack, "")
End Function

 

[ptm0412]

Tạm thời chưa có bài tập mới, các bạn hãy nghiên cứu topic Liệt kê các số đẹp lên bảng tính.
Tất cả các bài giải đều dùng vòng lặp For, tuy nhiên, mỗi người đưa lên 1 thuật toán khác nhau, các thủ thuật cũng khác nhau, cuối cùng là biện pháp cải thiện tốc độ. Co thể nói đó là những bài tập hay về suy luận logic và thủ thuật. Đặc biệt là biện pháp ứng dụng mảng.

 

[huuthang_bd]

Trong thời gian chờ đợi một bài tập hay các bạn thử làm bài này xem:

Tạo một Sub() để tạo mã theo nguyên tắc sau: Người dùng sẽ nhập vào mã bắt đầu gồm 5 chữ cái (XXXXX) và số lượng mã cần tạo (n), code sẽ tạo ra dãy n mã tiếp theo mã người dùng đã nhập. Các mã mới tạo nhập vào cột A bắt đầu từ A1.
Ví dụ: Nhập vào mã HUBIY và n = 6. Code sẽ tạo ra các mã HUBIZ, HUBJA, HUBJB, HUBJC, HUBJD, HUBJE

 

[Tường_Vi]

VỚi người mới tập tành VBA
Tường Vi cũng có một bài tập liên quan đến vòng lập nhưng chưa làm được
Thực tế: Một file có nhiều sheet (chứa nhiều công thức và link), khi gửi báo cáo, muội toàn phải làm thủ công copy & pastespecial value từng sheet 1
Vậy làm sao để Tạo một sub để copy & pastespecial value tất cả các sheet trong một file?

Xin các Huynh chỉ giáo?

 

[keentwo]

VỚi người mới tập tành VBA
Tường Vi cũng có một bài tập liên quan đến vòng lập nhưng chưa làm được
Thực tế: Một file có nhiều sheet (chứa nhiều công thức và link), khi gửi báo cáo, muội toàn phải làm thủ công copy & pastespecial value từng sheet 1
Vậy làm sao để Tạo một sub để copy & pastespecial value tất cả các sheet trong một file?

Xin các Huynh chỉ giáo?

-Em thấy cái này cũng nhiều mà,hay chị cứ đưa file cụ thể của chị chắc chắn sẽ OK
-Đây chỉ là file e làm nữa đêm hôm trước cho ai đó

 

[concogia]

Trong thời gian chờ đợi một bài tập hay các bạn thử làm bài này xem:

Tạo một Sub() để tạo mã theo nguyên tắc sau: Người dùng sẽ nhập vào mã bắt đầu gồm 5 chữ cái (XXXXX) và số lượng mã cần tạo (n), code sẽ tạo ra dãy n mã tiếp theo mã người dùng đã nhập. Các mã mới tạo nhập vào cột A bắt đầu từ A1.
Ví dụ: Nhập vào mã HUBIY và n = 6. Code sẽ tạo ra các mã HUBIZ, HUBJA, HUBJB, HUBJC, HUBJD, HUBJE

Sao khó ngủ quá

Private Sub CommandButton1_Click()
    Dim Ma As String, So As Integer, I As Integer, j As Integer
        Ma = [a1]
        So = [a2]
            If So > 26 Then MsgBox ("KHÔNG CHOI"): Exit Sub
            Range("b:b,C:C").ClearContents
                j = Asc(Right(Ma, 1))
                    For I = 1 To So
                        If j + I > 90 Then j = 65 - I
                        Cells(I, 2) = Replace(Ma, Right(Ma, 1), Chr((j) + I))
                    Next
    Range([b1], [b1].End(xlDown)).Offset(0, 1) = [row(A:A)]
End Sub

Nếu chạy đủ một vòng các chữ cái rồi thì làm gì nữa, hay chỉ chạy trong vòng các chữ cái rồi.....đi ngủ???

 

[rollover79]

Sao khó ngủ quá

Private Sub CommandButton1_Click()
    Dim Ma As String, So As Integer, I As Integer, j As Integer
        Ma = [a1]
        So = [a2]
            If So > 26 Then MsgBox ("KHÔNG CHOI"): Exit Sub
            Range("b:b,C:C").ClearContents
                j = Asc(Right(Ma, 1))
                    For I = 1 To So
                        If j + I > 90 Then j = 65 - I
                        Cells(I, 2) = Replace(Ma, Right(Ma, 1), Chr((j) + I))
                    Next
    Range([b1], [b1].End(xlDown)).Offset(0, 1) = [row(A:A)]
End Sub

Nếu chạy đủ một vòng các chữ cái rồi thì làm gì nữa, hay chỉ chạy trong vòng các chữ cái rồi.....đi ngủ???

Trong yêu cầu đã có ví dụ cụ thể rồi còn gì, chạy 1 vòng thì bài này làm gì phải bàn nữa. Tổng quát thì bài này nhập vào N chữ cái(miễn sao ko có ký số) và M là số phần tử cần trả về. Tưởng tượng giống như COLUMN của excel ấy, nhập vào cột ban đầu là A thì cột thứ 26 là Z, cột 27 là AA, cột thứ 28 là AB, ... cột thứ 256 là IV

 

[ptm0412]

Sao khó ngủ quá

 1.           If So > 26 Then MsgBox ("KHÔNG CHOI"): Exit Sub
 2.          Range("b:b,C:C").ClearContents
 3.                        Cells(I, 2) = Replace(Ma, Right(Ma, 1), Chr((j) + I))

Nếu chạy đủ một vòng các chữ cái rồi thì làm gì nữa, hay chỉ chạy trong vòng các chữ cái rồi.....đi ngủ???

1. Nếu chỉ lấy 1 chữ cái, không có AA, AB, ... thì 25 thôi Cò ơi, 26 cũng không chơi nốt.
2. sao hông viết Range("B:C") cho nhẹ, lẹ, phẻ?
3. Dùng Replace vô đây không ổn, nếu A1 = ConcoC, thì kết quả mắc cười lắm, nào là Đón Cò, nào là Nón Cò, Rốn Cò, Sơn Cò, Tồn Cò, Vốn Cò, Bồn Cò, hihihihi luôn.

 

[MinhCong]

Sao khó ngủ quá

Private Sub CommandButton1_Click()
    Dim Ma As String, So As Integer, I As Integer, j As Integer
        Ma = [a1]
        So = [a2]
            If So > 26 Then MsgBox ("KHÔNG CHOI"): Exit Sub
            Range("b:b,C:C").ClearContents
                j = Asc(Right(Ma, 1))
                    For I = 1 To So
                        If j + I > 90 Then j = 65 - I
                        Cells(I, 2) = Replace(Ma, Right(Ma, 1), Chr((j) + I))
                    Next
    Range([b1], [b1].End(xlDown)).Offset(0, 1) = [row(A:A)]
End Sub

Nếu chạy đủ một vòng các chữ cái rồi thì làm gì nữa, hay chỉ chạy trong vòng các chữ cái rồi.....đi ngủ???

Chưa đúng theo ý của tác giả đâu Anh. Theo Em nghĩ quy luật bài toán này tương tự như cách chạy của đồng hồ bấm số ấy
(hh:mm:ss)

 

[rollover79]

Trong thời gian chờ đợi một bài tập hay các bạn thử làm bài này xem:

Tạo một Sub() để tạo mã theo nguyên tắc sau: Người dùng sẽ nhập vào mã bắt đầu gồm 5 chữ cái (XXXXX) và số lượng mã cần tạo (n), code sẽ tạo ra dãy n mã tiếp theo mã người dùng đã nhập. Các mã mới tạo nhập vào cột A bắt đầu từ A1.
Ví dụ: Nhập vào mã HUBIY và n = 6. Code sẽ tạo ra các mã HUBIZ, HUBJA, HUBJB, HUBJC, HUBJD, HUBJE

Đây là bài toán ngược với bài toán này chuyển chỉ số cột thành chữ cái

 

[huuthang_bd]

Chưa đúng theo ý của tác giả đâu Anh. Theo Em nghĩ quy luật bài toán này tương tự như cách chạy của đồng hồ bấm số ấy
(hh:mm:ss)

Tôi nghĩ cũng nên đưa ra một quy tắc chung luôn cho thống nhất. Gần giống như bạn nói, lấy quy tắc như chỉ số trên các công tơ. Khi chạy đến số 999999 thì chạy tiếp công tơ sẽ chạy về số 000000. Ở đây, khi đến mã ZZZZZ thì mã tiếp theo là AAAAA.

 

[boyxin]

Trong thời gian chờ đợi một bài tập hay các bạn thử làm bài này xem:
Tạo một Sub() để tạo mã theo nguyên tắc sau: Người dùng sẽ nhập vào mã bắt đầu gồm 5 chữ cái (XXXXX) và số lượng mã cần tạo (n), code sẽ tạo ra dãy n mã tiếp theo mã người dùng đã nhập. Các mã mới tạo nhập vào cột A bắt đầu từ A1.
Ví dụ: Nhập vào mã HUBIY và n = 6. Code sẽ tạo ra các mã HUBIZ, HUBJA, HUBJB, HUBJC, HUBJD, HUBJE

Tôi nghĩ cũng nên đưa ra một quy tắc chung luôn cho thống nhất. Gần giống như bạn nói, lấy quy tắc như chỉ số trên các công tơ. Khi chạy đến số 999999 thì chạy tiếp công tơ sẽ chạy về số 000000. Ở đây, khi đến mã ZZZZZ thì mã tiếp theo là AAAAA.

Em mới nghĩ được đến đây thôi. Mong các bác chỉ bảo thêm

 

[rollover79]

Tôi nghĩ cũng nên đưa ra một quy tắc chung luôn cho thống nhất. Gần giống như bạn nói, lấy quy tắc như chỉ số trên các công tơ. Khi chạy đến số 999999 thì chạy tiếp công tơ sẽ chạy về số 000000. Ở đây, khi đến mã ZZZZZ thì mã tiếp theo là AAAAA.

Bài này ngoài kiến thức về vòng lặp còn có chút về logic cơ số như bài toán ngược tôi đã giới thiệu trong bài 169, do đó với những bạn mới sẽ cảm thấy tương đối khó, boyxin đã đưa ra được lời giải nhưng có vẻ hơi rối, tôi xin đưa ra 2 cách làm như saugiả sử ô A1 chứa mã ban đầu, ô A2 chứa số mã tiếp theo cần sinh)
Cách 1:

Sub Ma1()
    Dim sText As String, N As Integer
    sText = UCase([A1])
    N = [A2]
    Dim i As Integer, j As Integer, code As Integer, sTemp As String
    
    For i = 1 To N
        sTemp = ""
        For j = Len(sText) To 1 Step -1
            code = Asc(Mid(sText, j, 1)) - Asc("A") + 1
            sTemp = Chr(((code Mod 26) + 1) + Asc("A") - 1) & sTemp
            If code < 26 Then Exit For
        Next
        sText = Left(sText, IIf(j > 0, j - 1, 0)) & sTemp
        Range("B" & i) = sText
    Next
End Sub

Cách 2:

Function Text2Number(sText As String) As Long
    sText = UCase(sText)
    Dim i As Integer
    Dim iRet As Long
    For i = 1 To Len(sText)
        iRet = iRet + (Asc(Mid(sText, i, 1)) - Asc("A") + 1) * (26 ^ (Len(sText) - i))
    Next
    Text2Number = iRet
End Function

Function Number2Text(iNumber As Long) As String
    If iNumber <= 26 Then
        Number2Text = Chr(iNumber + Asc("A") - 1)
    Else
        Number2Text = Number2Text((iNumber - 1) \ 26) & Chr(((iNumber - 1) Mod 26) + Asc("A"))
    End If
End Function

Sub Ma2()
    Dim sText As String, N As Integer
    sText = UCase([A1])
    N = [A2]
    
    Dim i As Integer, iTemp As Long
    iTemp = Text2Number(sText)
    For i = 1 To N
        Range("C" & i) = Number2Text(iTemp + i)
    Next
End Sub

 

[huuthang_bd]

Em mới nghĩ được đến đây thôi. Mong các bác chỉ bảo thêm

Xét về kết quả thì bài giải của bạn đạt yêu cầu nhưng về thuật toán thì chưa tốt. Bạn sử dụng quá nhiều biến mà nếu bạn phân tích kỹ thì sẽ giảm được đáng kể số biến. Mặt khác, nếu mở rộng số ký tự của mã cần tạo là tự do chứ không phải là 5 ký tự thì thuật toán của bạn chưa giải quyết được.

Tôi xin hướng dẫn sơ về thuật toán của bài này như sau:
Trong mã gồm một dãy các chữ cái bạn chỉ cần quan tâm đến 1 chữ cái trong dãy đó, đó là chữ cái cuối cũng không phải là chữ "Z". Vì khi nhảy sang mã tiếp theo các chữ cái đứng trước chữ cái đó sẽ không đổi, bản thân chữ cái đó sẽ nhảy lên 1 đơn vị (tôi tạm gọi là đơn vị) và các chữ cái đứng sau chữ cái đó sẽ là chữ "A". Ví du:
- Mã TUAOBQ bạn cần quan tâm đến ký tự thứ 6 (ký tự cuối cùng không phải là chữ "Z"). Mã tiếp theo sẽ là TUAOBR
- Mã TUAOBZ bạn cần quan tâm đến ký tự thứ 5 (ký tự cuối cùng không phải là chữ "Z"). Mã tiếp theo sẽ là TUAOCA
- Mã TUAOZZ bạn cần quan tâm đến ký tự thứ 6 (ký tự cuối cùng không phải là chữ "Z"). Mã tiếp theo sẽ là TUAPAA
Kết hợp các hàm Len(),RTrim() và Replace() để xác định vị trí của ký tự này.

 

[ptm0412]

Quan điểm của tôi là suy luận logic, nhưng ưu tiên thuật toán đơn giản.
Logic của bài này rõ ràng là tương tự hệ đếm cơ số 26. Tuy vậy, không nhất thiết phải xài đến công thức liên quan đến 26^n hay i Mod 26.

Tôi suy luận theo hướng:
- nếu ASC(ký tự cuối số 5) < 90, thì cộng 1, nếu = 90, quay về 65
- Nếu Asc(ký tự 5) = 90, và nếu Asc(ký tự 4) = 90, quay về 65, nếu asc(ký tự 4) <> 90, thì tăng 1. ...,
- tương tự các ký tự khác
Code rất ngắn, 1 vòng lặp, chưa dùng mảng đã xem xem code boyxin chậm hơn 1 chút xíu thôi.

Vấn đề là suy luận hướng này phù hợp với người mới làm quen tư duy logic, theo kiểu đồng hồ đo điện: 00099 thành 00100, 99999 trở về 00000

Nếu dùng mảng, 60.000 mã dưới 1 giây (máy què 1 cây ram, chỉ còn 1 cây):

Sub taoma()
Dim Ma As String, So As Long, N(1 To 5), MaN()
Ma = [A1]: So = [b1]
ReDim MaN(So, 1)
t = Timer
For i = 1 To 5
    N(i) = Asc(Mid(Ma, i, 1))
Next

For i = 1 To So
    N(1) = IIf(N(2) = 90 And N(3) = 90 And N(4) = 90 And N(5) = 90, IIf(N(1) = 90, 65, N(1) + 1), N(1))
    N(2) = IIf(N(3) = 90 And N(4) = 90 And N(5) = 90, IIf(N(2) = 90, 65, N(2) + 1), N(2))
    N(3) = IIf(N(4) = 90 And N(5) = 90, IIf(N(3) = 90, 65, N(3) + 1), N(3))
    N(4) = IIf(N(5) = 90, IIf(N(4) = 90, 65, N(4) + 1), N(4))
    N(5) = IIf(N(5) = 90, 65, N(5) + 1)
    MaN(i, 1) = Chr(N(1)) & Chr(N(2)) & Chr(N(3)) & Chr(N(4)) & Chr(N(5))
Next
Range("A2:A" & So + 1) = MaN
[b2] = Timer - t
End Sub

 

[ndu96081631]

Cách của tôi cũng gần giống với rollover79, tức dựa vào việc chuyển cơ số

Function StrToN26(Text As String) As Long
  Dim i As Long, Temp As Long
  Const ALPHAB = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  Text = UCase(Text)
  For i = 1 To Len(Text)
    If InStr(ALPHAB, Mid(Text, i, 1)) = 0 Then Exit Function
    Temp = Temp + (InStr(ALPHAB, Mid(Text, i, 1)) - 1) * 26 ^ (Len(Text) - i)
  Next
  StrToN26 = Temp
End Function

Function N26ToStr(Num As Long) As String
  Dim rd As Long, qt As Long, Temp As Long
  Const ALPHAB = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  Temp = Num
  Do
    rd = Int(Temp / 26)
    qt = Temp Mod 26
    Temp = rd
    N26ToStr = Mid(ALPHAB, qt + 1, 1) & N26ToStr
  Loop Until rd = 0
End Function

Function GetCodelist(stCode As String, Amount As Long, Length As Long)
  Dim Temp As Long, i As Long, Arr()
  ReDim Arr(1 To Amount, 1 To 1)
  Temp = StrToN26(stCode)
  Arr(1, 1) = Right(String(Length, "A") & stCode, Length)
  For i = 1 To Amount - 1
    Arr(i + 1, 1) = Right(String(Length, "A") & N26ToStr(Temp + i), Length)
  Next
  GetCodelist = Arr
End Function

Thuật toán:
- Có 1 chuổi cho trước, ta chuyển chúng thành giá trị số theo cơ số 26
- Lần lượt cộng vào kết quả từng đơn vị một rồi chuyển chúng sang chuổi (cũng theo cơ số 26)
Xem file

 

[ptm0412]

Nếu bài tập vòng lặp cho người mới mà dùng hàm, lại là hàm mảng nữa thì làm sao mọi người theo kịp? Do đó tôi chỉ dùng sub và thuật toán đơn giản. Nếu kèm theo giải thích nữa thì càng tốt.
Bài này tương đối khó, cần phải dựa vào quan sát tìm ra quy luật.
Thuật toán tìm ký tự cuối không phải Z của huuthangbd cũng là dựa vào quan sát.

Việc chuyển Sub thành Function có lẽ nên mở 1 topic mới.

 

[ptm0412]

Xét về kết quả thì bài giải của bạn đạt yêu cầu nhưng về thuật toán thì chưa tốt. Bạn sử dụng quá nhiều biến mà nếu bạn phân tích kỹ thì sẽ giảm được đáng kể số biến. Mặt khác, nếu mở rộng số ký tự của mã cần tạo là tự do chứ không phải là 5 ký tự thì thuật toán của bạn chưa giải quyết được.

Tôi xin hướng dẫn sơ về thuật toán của bài này như sau:
Trong mã gồm một dãy các chữ cái bạn chỉ cần quan tâm đến 1 chữ cái trong dãy đó, đó là chữ cái cuối cũng không phải là chữ "Z". Vì khi nhảy sang mã tiếp theo các chữ cái đứng trước chữ cái đó sẽ không đổi, bản thân chữ cái đó sẽ nhảy lên 1 đơn vị (tôi tạm gọi là đơn vị) và các chữ cái đứng sau chữ cái đó sẽ là chữ "A".
Kết hợp các hàm Len(),RTrim() và Replace() để xác định vị trí của ký tự này.

- Tìm vị trí ký tự Z đầu tiên bằng Instr, trừ đi 1 ra ký tự cuối không phải Z (bên trái Z). (Có điều kiện kèm theo khi tìm không có ký tự Z nào)
- Còn phải xác định ký tự cuối có phải Z hay không nữa, rồi mới quyết định tăng 1 "đơn vị" cho "ký tự cuối" hay "ký tự cuối cùng không phải Z". Nghĩa là còn phải xem sau chữ Z đầu tiên, có ký tự không phải Z nào hay không, lấy ký tự cuối cùng không phải Z bên phải Z để tăng 1 đơn vị.

 

[boyxin]

Với chuỗi gồm 5 ký tự ban đầu sẽ có thể tạo ra 26^5 = 11 881 376 mã khác nhau

Nếu muốn liệt kê 120 000 mã thôi (khoảng 1% tổng số) khi đó có cần quan tâm đến tốc độ xử lý không?

Vấn đề code dài hay ngắn, dễ nhìn hay rối mắt liệu có quan trọng bằng so với việc cho code chạy 1 nhát thì ngỗi đợi như vô quán cafe hay què RAM ... Nên khi xử lý dữ liệu lớn, mình thường hay quan tâm đến tốc độ xử lý (thuật toán) và cách trình bày hơn so với việc rút gọn code hay trình bày code dễ nhìn.

Sau khi đạt kết quả đúng theo yêu cầu rồi thì mới tính đến chuyện nâng cấp, mởi rộng, ... Không biết các bác tính sao về vấn đề này

 

[ndu96081631]

Nếu bài tập vòng lặp cho người mới mà dùng hàm, lại là hàm mảng nữa thì làm sao mọi người theo kịp? Do đó tôi chỉ dùng sub và thuật toán đơn giản. Nếu kèm theo giải thích nữa thì càng tốt.
Bài này tương đối khó, cần phải dựa vào quan sát tìm ra quy luật.
Thuật toán tìm ký tự cuối không phải Z của huuthangbd cũng là dựa vào quan sát.

Việc chuyển Sub thành Function có lẽ nên mở 1 topic mới.

Nếu sư phụ không thích mảng thì bỏ code thứ 3 đi, khi ấy ta dùng như sau:
- Giả sử nhập vào cell A1 code gì đó
- Tại A2 ta gõ công thức:

=RIGHT(REPT("A",LEN(A1)) & N26ToStr(StrToN26(A1)+1),LEN(A1))

- Kéo fill xuống đến đâu tùy ý
-----------------
Còn chuyện Function hay Sub em nghĩ nó cũng như nhau thôi mà sư phụ!

 

[huuthang_bd]

Xét về kết quả thì bài giải của bạn đạt yêu cầu nhưng về thuật toán thì chưa tốt. Bạn sử dụng quá nhiều biến mà nếu bạn phân tích kỹ thì sẽ giảm được đáng kể số biến. Mặt khác, nếu mở rộng số ký tự của mã cần tạo là tự do chứ không phải là 5 ký tự thì thuật toán của bạn chưa giải quyết được.

Tôi xin hướng dẫn sơ về thuật toán của bài này như sau:
Trong mã gồm một dãy các chữ cái bạn chỉ cần quan tâm đến 1 chữ cái trong dãy đó, đó là chữ cái cuối cũng không phải là chữ "Z". Vì khi nhảy sang mã tiếp theo các chữ cái đứng trước chữ cái đó sẽ không đổi, bản thân chữ cái đó sẽ nhảy lên 1 đơn vị (tôi tạm gọi là đơn vị) và các chữ cái đứng sau chữ cái đó sẽ là chữ "A". Ví du:
- Mã TUAOBQ bạn cần quan tâm đến ký tự thứ 6 (ký tự cuối cùng không phải là chữ "Z"). Mã tiếp theo sẽ là TUAOBR
- Mã TUAOBZ bạn cần quan tâm đến ký tự thứ 5 (ký tự cuối cùng không phải là chữ "Z"). Mã tiếp theo sẽ là TUAOCA
- Mã TUAOZZ bạn cần quan tâm đến ký tự thứ 6 (ký tự cuối cùng không phải là chữ "Z"). Mã tiếp theo sẽ là TUAPAA
Kết hợp các hàm Len(),RTrim() và Replace() để xác định vị trí của ký tự này.

Đây là code theo thuật toán tôi đã trình bày:

Sub Test()
Dim Str As String, N As Long, i As Long, C As Long
ActiveSheet.[A:A].ClearContents
Str = UCase(InputBox("Ma bat dau:", , "AAAAAA"))
N = InputBox("So ma can tao:", , 1000)
For i = 1 To N
    C = Len(RTrim(Replace(Str, "Z", " ")))
    If C = 0 Then
        Str = String(Len(Str), "A")
    Else
        Str = Left(Str, C - 1) & Chr(Asc(Mid(Str, C, 1)) + 1) & String(Len(Str) - C, "A")
    End If
    Cells(i, 1).Value = Str
Next
End Sub

Vì là bài tập về vòng lặp nên tôi thấy việc gán kết quả vào mảng để cải thiệt tốc độ là không cần thiết. Điều quan trọng là thuật toán.

- Tìm vị trí ký tự Z đầu tiên bằng Instr, trừ đi 1 ra ký tự cuối không phải Z (bên trái Z). (Có điều kiện kèm theo khi tìm không có ký tự Z nào)
- Còn phải xác định ký tự cuối có phải Z hay không nữa, rồi mới quyết định tăng 1 "đơn vị" cho "ký tự cuối" hay "ký tự cuối cùng không phải Z". Nghĩa là còn phải xem sau chữ Z đầu tiên, có ký tự không phải Z nào hay không, lấy ký tự cuối cùng không phải Z bên phải Z để tăng 1 đơn vị.

Kết hợp các hàm Len(),RTrim() và Replace() để xác định vị trí của ký tự cuối cùng không phải là "Z" có lẽ sẽ đơn giản hơn.

 

[ndu96081631]

Vì là bài tập về vòng lặp nên tôi thấy việc gán kết quả vào mảng để cải thiệt tốc độ là không cần thiết.

ah... không bạn à! Mảng tôi dùng ở đây không phải với mục đích tăng tốc (thực chất cũng không hề tăng tốc tí nào)... mà là để dễ sử dụng ---> Chẳng hạn người ta muốn tạo 10 mã thì chỉ việc quét chọn 10 cell rồi gõ công thức trên thanh Formula, Ctrl + Shift + Enter để ra kết quả
Chỉ vậy thôi

 

[huuthang_bd]

ah... không bạn à! Mảng tôi dùng ở đây không phải với mục đích tăng tốc (thực chất cũng không hề tăng tốc tí nào)... mà là để dễ sử dụng ---> Chẳng hạn người ta muốn tạo 10 mã thì chỉ việc quét chọn 10 cell rồi gõ công thức trên thanh Formula, Ctrl + Shift + Enter để ra kết quả
Chỉ vậy thôi

Tôi đang đề cập đến việc gán kết quả vào mảng trước khi nhập vào sheet như trong bài giải của boyxin và ptm0412.

 

[ptm0412]

Với chuỗi gồm 5 ký tự ban đầu sẽ có thể tạo ra 26^5 = 11 881 376 mã khác nhau

Nếu muốn liệt kê 120 000 mã thôi (khoảng 1% tổng số) khi đó có cần quan tâm đến tốc độ xử lý không?

Vấn đề code dài hay ngắn, dễ nhìn hay rối mắt liệu có quan trọng bằng so với việc cho code chạy 1 nhát thì ngỗi đợi như vô quán cafe hay què RAM ... Nên khi xử lý dữ liệu lớn, mình thường hay quan tâm đến tốc độ xử lý (thuật toán) và cách trình bày hơn so với việc rút gọn code hay trình bày code dễ nhìn.

Không hiểu rõ lắm ý của Boyxin?
Xin trình bày lại như sau:
- Mỗi người có thể nghĩ ra thuật toán khác nhau: Boyxin, tôi, huuthang, RollOver+ndu, gồm 4 thuật toán. Chúng ta sẽ cùng nghiên cứu mổ xẻ các thuật toán này và học hỏi lẫn nhau. Khi chúng ta thảo luận, các thành viên đang học sẽ thấy thêm nhiều ý kiến bổ ích, và cả chúng ta nữa. Thí dụ thuật toán của huuthang, tôi đã hiểu nhưng chưa áp dụng được cho đến khi huuthang đưa đáp án lên. Vô hình trung tôi cũng học thêm 1 cách hay!
- Về việc có nên cải thiện tốc độ không, thì tôi nghĩ đương nhiên là cần, nhất là máy yếu như máy của tôi hiện giờ (nói cho vui là què ram). Cả boyxin và tôi đêu dùng mảng để cải thiện tốc độ. Điều này cũng giúp cho các thành viên đang học có thêm nhiều tham khảo. Thiết nghĩ, dùng mảng để gán giá trị vào trước khi gán xuống sheet cũng không phải khó khăn lắm, MinhCong đã làm được đấy thôi.

Sau khi đạt kết quả đúng theo yêu cầu rồi thì mới tính đến chuyện nâng cấp, mởi rộng, ... Không biết các bác tính sao về vấn đề này

Theo tôi nghĩ và đã từng kinh nghiệm, có những thuật toán có thể nâng cấp, mở rộng, nhưng cũng có những thuật toán chỉ đành gạt nước mắt mà vứt bỏ. Thí dụ code của tôi, nếu Mã có độ dài bất kỳ cũng chưa biết sẽ cải tiến ra sao, hay là vứt đi nữa.

Còn chuyện Function hay Sub em nghĩ nó cũng như nhau thôi mà sư phụ!

Không hẳn thế đâu, ngay cả tôi cũng đã đánh vật với việc chuyển Sub thành Function biết bao nhiêu lâu, và vẫn còn đang phải học.

 

[rollover79]

Các phương pháp mọi người đưa ra đều có 1 điểm chung là sử dụng hàm Chr và Asc để tăng 1 ký tự lên 1 đơn vị. Và ngoài cách của bạn huu_thang sử dụng phương pháp sử phép toán xử lý chuỗi ra, mọi người đều bị mắc 1 chỗ là khi tăng ký tự Z. Tôi xin gửi thêm 1 phương pháp kết hợp thêm 1 chút thủ thuật để dễ dàng xử lý hơn như sau

Sub Ma3()
    Const sAlpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZA"
    Dim arrAlpha
    arrAlpha = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "A")
    
    Dim sText As String, N As Integer, i As Integer, j As Integer, iPos As Integer, sTemp As String
    sText = [A1]
    N = [A2]
    For i = 1 To N
        sTemp = ""
        For j = Len(sText) To 1 Step -1
            iPos = InStr(1, sAlpha, Mid(sText, j, 1))
            sTemp = arrAlpha(iPos) & sTemp
            If iPos < 26 Then Exit For
        Next
        sText = Left(sText, IIf(j = 0, 0, j - 1)) & sTemp
        Cells(i, 2) = sText
    Next
End Sub

Cũng xin nói thêm 1 chút về phương pháp của tôi và ndu đã đề cập, nó có cái hay riêng của nó. Giả sử cũng với 1 yêu cầu gần tương tự như thế này nhưng có 1 chút thay đổi như sau, nhập vào Mã ban đầu và số N, nhưng thay vì liệt kê ra N mã tiếp theo bằng đưa ra 1 mã thứ N tiếp theo mã ban đầu, khi đó các bạn sẽ thấy rõ sự khác biệt.

 

[huuthang_bd]

Các phương pháp mọi người đưa ra đều có 1 điểm chung là sử dụng hàm Chr và Asc để tăng 1 ký tự lên 1 đơn vị. Và ngoài cách của bạn huu_thang sử dụng phương pháp sử phép toán xử lý chuỗi ra, mọi người đều bị mắc 1 chỗ là khi tăng ký tự Z. Tôi xin gửi thêm 1 phương pháp kết hợp thêm 1 chút thủ thuật để dễ dàng xử lý hơn như sau

Sub Ma3()
    Const sAlpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZA"
    Dim arrAlpha
    arrAlpha = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "A")
    
    Dim sText As String, N As Integer, i As Integer, j As Integer, iPos As Integer, sTemp As String
    sText = [A1]
    N = [A2]
    For i = 1 To N
        sTemp = ""
        For j = Len(sText) To 1 Step -1
            iPos = InStr(1, sAlpha, Mid(sText, j, 1))
            sTemp = arrAlpha(iPos) & sTemp
            If iPos < 26 Then Exit For
        Next
        sText = Left(sText, IIf(j = 0, 0, j - 1)) & sTemp
        Cells(i, 2) = sText
    Next
End Sub

sAlpha và arrAlpha cũng gần gần giống nhau, sao bạn không bỏ bớt arrAlpha cho gọn.
Và bạn đặt tên Sub() là Ma3 người dùng sử dụng Excel phiên bản 2007 trở về sau sẽ gặp rắc rối.

Sub Test()
    Const sAlpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZA"
    Dim arrAlpha
    Dim sText As String, N As Integer, i As Integer, j As Integer, iPos As Integer, sTemp As String
    sText = [A1]
    N = [A2]
    For i = 1 To N
        sTemp = ""
        For j = Len(sText) To 1 Step -1
            iPos = InStr(1, sAlpha, Mid(sText, j, 1))
            sTemp = Mid(sAlpha, iPos + 1, 1) & sTemp
            If iPos < 26 Then Exit For
        Next
        sText = Left(sText, IIf(j = 0, 0, j - 1)) & sTemp
        Cells(i, 2) = sText
    Next
End Sub

Cũng xin nói thêm 1 chút về phương pháp của tôi và ndu đã đề cập, nó có cái hay riêng của nó. Giả sử cũng với 1 yêu cầu gần tương tự như thế này nhưng có 1 chút thay đổi như sau, nhập vào Mã ban đầu và số N, nhưng thay vì liệt kê ra N mã tiếp theo bằng đưa ra 1 mã thứ N tiếp theo mã ban đầu, khi đó các bạn sẽ thấy rõ sự khác biệt.

Trường hợp này lại khác nữa. Mỗi bài toán có một cách giải quyết riêng. Và theo tôi, viết code không nên có tư tưởng viết để sau này gặp trường hợp khác lấy code đó ra xài luôn.

 

[rollover79]

sAlpha và arrAlpha cũng gần gần giống nhau, sao bạn không bỏ bớt arrAlpha cho gọn.
Và bạn đặt tên Sub() là Ma3 người dùng sử dụng Excel phiên bản 2007 trở về sau sẽ gặp rắc rối.

Sub Test()
    Const sAlpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZA"
    Dim arrAlpha
    Dim sText As String, N As Integer, i As Integer, j As Integer, iPos As Integer, sTemp As String
    sText = [A1]
    N = [A2]
    For i = 1 To N
        sTemp = ""
        For j = Len(sText) To 1 Step -1
            iPos = InStr(1, sAlpha, Mid(sText, j, 1))
            sTemp = Mid(sAlpha, iPos + 1, 1) & sTemp
            If iPos < 26 Then Exit For
        Next
        sText = Left(sText, IIf(j = 0, 0, j - 1)) & sTemp
        Cells(i, 2) = sText
    Next
End Sub

Trường hợp này lại khác nữa. Mỗi bài toán có một cách giải quyết riêng. Và theo tôi, viết code không nên có tư tưởng viết để sau này gặp trường hợp khác lấy code đó ra xài luôn.

Gần giống nhau không có nghĩa là giống nhau bạn ạ, trong code bạn cũng đã thấy rồi, dùng thêm cái arrAlpha tôi có thể dùng luôn iPos làm chỉ số cho mảng mà chẳng cần phải dùng hàm MID. Còn có nên có tư tưởng viết để sau này gặp trường hợp khác lấy code đó xài luôn thì tùy vào mỗi người, dẫu sao trong trường hợp này nó vẫn là 1 cách làm, vấn đề này mà đem bàn ở đây thì e rằng không thích hợp. Còn trên thực tế mà hễ cứ gặp 1 tình huống mà chỉ viết code xử lý đúng tình huống đó, mà không xem xét các tình huống tương tự có thể gặp mà cover luôn thì e rằng tay của lập trình sẽ ngày 1 to ra vì phải gõ code nhiều.

 

[huuthang_bd]

Còn trên thực tế mà hễ cứ gặp 1 tình huống mà chỉ viết code xử lý đúng tình huống đó, mà không xem xét các tình huống tương tự có thể gặp mà cover luôn thì e rằng tay của lập trình sẽ ngày 1 to ra vì phải gõ code nhiều.

Có lẽ do tôi không phải là một lập trình viên nên có quan điểm khác với lập trình viên.
Tôi chỉ nêu quan điểm của tôi và không muốn tranh luận về vấn đề này ở đây nữa.

 

[ndu96081631]

Các phương pháp mọi người đưa ra đều có 1 điểm chung là sử dụng hàm Chr và Asc để tăng 1 ký tự lên 1 đơn vị. Và ngoài cách của bạn huu_thang sử dụng phương pháp sử phép toán xử lý chuỗi ra, mọi người đều bị mắc 1 chỗ là khi tăng ký tự Z. Tôi xin gửi thêm 1 phương pháp kết hợp thêm 1 chút thủ thuật để dễ dàng xử lý hơn như sau

Sub Ma3()
    Const sAlpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZA"
    Dim arrAlpha
    arrAlpha = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "A")
    
    Dim sText As String, N As Integer, i As Integer, j As Integer, iPos As Integer, sTemp As String
    sText = [A1]
    N = [A2]
    For i = 1 To N
        sTemp = ""
        For j = Len(sText) To 1 Step -1
            iPos = InStr(1, sAlpha, Mid(sText, j, 1))
            sTemp = arrAlpha(iPos) & sTemp
            If iPos < 26 Then Exit For
        Next
        sText = Left(sText, IIf(j = 0, 0, j - 1)) & sTemp
        Cells(i, 2) = sText
    Next
End Sub

.

Mình thì sẽ sửa đoạn

arrAlpha = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "A")

thành:

[/B]arrAlpha = Split(StrConv(sAlpha, 64), Chr(0))[B]

 

[ThuNghi]

Mình thì sẽ sửa đoạn

arrAlpha = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "A")

thành:

[/B]arrAlpha = Split(StrConv(sAlpha, 64), Chr(0))[B]

Hay quá, mình cũng thấy cần phải rút gọn mà chưa nghĩ ra, mới nghĩ đến for i và gán vào array.
Cám ơn nhiều.

 

[Tường_Vi]

Bài tập về vòng lặp _ In theo danh sách filter

Muội có một data rất nhiều dữ liệu

- Tại cột A (cột Index --> có thể hiểu nó như các mã tài khoản) Các mã số này nằm rải rác không liên tục nhau

Bình thường muội vẫn phải filter và chọn theo thứ tự (mã Index để print) nhưng giờ muội muốn viết code in một lần được luôn

Muội đã nghĩ đến vòng lặp nhưng hiện tại chửa làm được, nhân tiện box bài tập về vòng lặp, xin gửi lên để nhận được trợ giúp

Xin cám ơn

 

[ndu96081631]

Muội có một data rất nhiều dữ liệu

- Tại cột A (cột Index --> có thể hiểu nó như các mã tài khoản) Các mã số này nằm rải rác không liên tục nhau

Bình thường muội vẫn phải filter và chọn theo thứ tự (mã Index để print) nhưng giờ muội muốn viết code in một lần được luôn

Muội đã nghĩ đến vòng lặp nhưng hiện tại chửa làm được, nhân tiện box bài tập về vòng lặp, xin gửi lên để nhận được trợ giúp

Xin cám ơn

Bài này có thể nói là RẤT DỂ nếu có dữ liệu đính kèm
Lọc duy nhất ta dùng Dictionary Object mà làm

 

[MinhCong]

Bài tập về Lọc những ô ở cột A có tô màu. Em dùng vòng lặp như sau không biết như thế có gây lỗi gì không. Thấy chạy cũng đúng. Mong các Anh có ý kiến để Em còn học hỏi nhé!

Sub Locmau()
 Dim enR, tmp(1 To 65536, 1 To 1), j, i As Long
  Range("B:B").Clear
   enR = Range("A65536").End(xlUp).Row
    For i = 1 To enR
        If Cells(i, 1).Interior.ColorIndex <> xlNone Then
            j = j + 1
            tmp(j, 1) = Cells(i, 1).Value
        End If
    Next
 Range("B1").Resize(j).Value = tmp
End Sub

 

[Tường_Vi]

Em rút gọn code này nhưng không được

Set wf = Application.WorksheetFunction
socont = wf.Sum(wf.VLookup(Bill, bangsosanh, 16, 0)) + wf.Sum(wf.VLookup(Bill, bangsosanh, 17, 0)) + wf.Sum(wf.VLookup(Bill, bangsosanh, 18, 0)) + wf.Sum(wf.VLookup(Bill, bangsosanh, 19, 0))

Em rút gọn thành

For i = 16 To 19
socont = wf.VLookup(Bill, bangsosanh, i, 0)
Next
socont = socont + socont

Em viết như trên nhưng dđược, các Huynh sửa cho em với

Cám ơn Ạh

 

[MinhCong]

Set wf = Application.WorksheetFunction
socont = wf.Sum(wf.VLookup(Bill, bangsosanh, 16, 0)) + wf.Sum(wf.VLookup(Bill, bangsosanh, 17, 0)) + wf.Sum(wf.VLookup(Bill, bangsosanh, 18, 0)) + wf.Sum(wf.VLookup(Bill, bangsosanh, 19, 0))

Em rút gọn thành

For i = 16 To 19
socont = wf.VLookup(Bill, bangsosanh, i, 0)
Next
socont = socont + socont

Em viết như trên nhưng dđược, các Huynh sửa cho em với

Cám ơn Ạh

Bạn gởi kèm file lên để mấy Anh Em học hỏi với, chứ ghi code không thế thấy khó hình dung quá!

 

[ThuNghi]

Set wf = Application.WorksheetFunction
socont = wf.Sum(wf.VLookup(Bill, bangsosanh, 16, 0)) + wf.Sum(wf.VLookup(Bill, bangsosanh, 17, 0)) + wf.Sum(wf.VLookup(Bill, bangsosanh, 18, 0)) + wf.Sum(wf.VLookup(Bill, bangsosanh, 19, 0))

Em rút gọn thành

For i = 16 To 19
socont = wf.VLookup(Bill, bangsosanh, i, 0)
Next
socont = socont + socont

Em viết như trên nhưng dđược, các Huynh sửa cho em với

Cám ơn Ạh

Em xem lại socont = socont + socont nên nằm trong hay ngoài vòng lặp nhé.

 

[ptm0412]

Em xem lại socont = socont + socont nên nằm trong hay ngoài vòng lặp nhé.

Nằm trong hay ngoài vòng lặp cũng sẽ cho kết quả sai.

1. Nằm trong:
- Cứ mỗi vòng lặp, socont lại lấy 1 giá trị mới.
- Kế đến, socont= socont + socont = 2 * socont. Kết quả này không lưu vào đâu hết
- Qua vòng lặp kế, lại vứt bỏ kết quả lần trước, nhận kết quả mới.

2. Nằm ngoài:
- Cứ mỗi vòng lặp, socont lại lấy 1 giá trị mới. Giá trị này cũng không lưu vào đâu hết
- Qua vòng lặp kế, lại vứt bỏ giá trị lần trước, nhận giá trị mới.
- Khi chạy đủ vòng, lấy giá trị cuối cùng, cộng với chính nó.

Tóm lại, phải có 1 biến tạm để lưu kết quả trung gian của mỗi vòng lặp. Thí dụ:

For i = 1 To 10
    j = i ^2
    ketqua = ketqua + j
Next

 

[le tin]

Tôi nghĩ thế này

For i = 16 To 19
socont = socont +wf.VLookup(Bill, bangsosanh, i, 0)
Next

 

[ThuNghi]

Tôi nghĩ thế này

For i = 16 To 19
socont = socont +wf.VLookup(Bill, bangsosanh, i, 0)
Next

Vậy là OK rồi. cám ơn Anh.
Bác PTM ơi, em nói là xem lại để trong hay ngoài thôi mà, còn giải thuật thì thêm biến tạm hay của Anh Lê Tin là OK. Nhưng hình như thiếu phần phải set lại socont=0. Nếu code độc lập và chỉ tính có 1 cell thì không cần.
Cám ơn 2 anh.

 

[ptm0412]

Biến tạm là nói về tổng quát. Trường hợp cụ thể sẽ không cần (như của anh LeTin).
Có trường hợp sẽ cần nếu như còn phải dùng giá trị tạm đó làm vài ba việc khác nữa.

Chứ thí dụ trong bài #196 chỉ cần thế này:

For i = 1 To 10
    ketqua = ketqua +  i ^2
Next

 

[Tường_Vi]

Tôi nghĩ thế này

For i = 16 To 19
socont = socont +wf.VLookup(Bill, bangsosanh, i, 0)
Next

Hóa ra lại phải viết như này he he, còn nếu trong công thức thì muội vẫn làm như vầy

socont = {sum(vlookup(bill, bangsosanh,{array};0))}

 

[ndu96081631]

Hóa ra lại phải viết như này he he, còn nếu trong công thức thì muội vẫn làm như vầy

Đó là vì xét về mặt thuật toán thì công thức mảng trong Excel y chang như vòng lập trong VBA! Tức:
- Trong bảng tính ta dùng mảng
- Trong VBA ta sẽ dùng vòng lập
Ẹc... Ẹc...
Từ đó mà suy luận tiếp

 

[phihndhsp]

Góp Hàm tìm s[FONT=&quot]ố lần xuất hiện nhiều nhất của 1 chữ số trong 1 số dương cho trước cho vui nhà vui cửa
Có gì sai xót xin góp ý dùm xin cảm ơn
[/FONT] [FONT=&quot]Ví dụ[/FONT]
[FONT=&quot] 112312 kết quả = 3(số 1 xuất hiện 3 lần)[/FONT]
[FONT=&quot]132333 kết quả = 4 ( số 3 xuất hiện 4 lần)[/FONT]

' --------dem so lan xuat hien cua tung so ----------------
Function Solan_a_xuathien_trong_n(ByVal n As Long, ByVal a As Byte) As Byte
Dim dem As Byte
dem = 0
Do While (n > 0)
If a = n Mod 10 Then dem = dem + 1

n = Int(n / 10)
Loop
Solan_a_xuathien_trong_n = dem

End Function

'----- tim so lan xuat hien nhieu nhat --------------'
Function kt_so_xuathien_nhieunhat(ByVal n As Long) As Byte
Dim max_xh As Byte
Dim sodu As Byte
Dim m As Long
m = n
max_xh = 0
Do While m > 0
sodu = m Mod 10
If (max_xh < Solan_a_xuathien_trong_n(n, sodu)) Then
max_xh = Solan_a_xuathien_trong_n(n, sodu)
End If
m = Int(m / 10)
Loop
kt_so_xuathien_nhieunhat = max_xh
End Function