Giúp về dùng vòng lặp

[vumian]

hi,

Mình cần giúp như mô tả trong file

Cám ơn nhiều

------------
FIle đã mô tả rõ hơn, Xem giúp mình

 

[Lam_A0]

Đưa những dòng trong khung vàng vào khung xanh, mỗi lẫn đưa vậy thì so sánh cái cell ngày nếu trùng thì không thêm ngày vào

Không hiểu lắm? Bạn để nhiều thứ trong project quá, chẳng biết đằng nào mà lần! Bạn nên sửa lại file, chỉ để cái nào liên quan trực tiếp đến bài toán. Thêm câu lệnh:

 Option explicit

và khai báo các biến sử dụng, như vậy mới rõ ràng và dễ đọc...
Thân!

 

[anhtuan1066]

Đúng là yêu cầu này chưa rõ ràng lắm... Điền vào là điền tới đâu? Tới dòng 65536 chăng? Và những cell màu vàng ấy thực chất chỉ có 3 cell hay còn nữa?
Tôi nghĩ bạn đang vướng 1 cái gì đó và đang tìm hướng đi bằng cách này.. Tức là giãi quyết dc yêu cầu này thì xem như giãi quyết dc bài toán thực tế của bạn, đúng ko?
Nên chăng bạn nói luôn việc bạn muốn làm vậy là đễ làm cái gì? Tôi nghĩ các cao thủ có thể gợi ý bạn 1 hướng đi khác chăng?
ANH TUẤN

 

[SA_DQ]

Cũng không nhất thiết phải vòng lặp

Bạn thử xem sao, với macro này!

Option Explicit
Sub CopyAndDel()
 Dim Ngay, lRow As Long:        Dim Rng As Range, Clls As Range
 
 Ngay = Range("F4")
 Set Rng = Range("E7:F" & Range("F65432").End(xlUp).Row)
 Set Clls = Range("M" & Range("M65432").End(xlUp).Row + 1)
 If Ngay <> Range("L65432").End(xlUp) Then Clls.Offset(, -1) = Ngay
 6  Rng.Copy Destination:=Clls
 Set Rng = Nothing:             Set Clls = Nothing
End Sub

 

[ptm0412]

Cho mình góp 1 câu:
Rng.Clear
vì Sub là Copy and delete mà chưa delete.

 

[nguyentuhp]

Nếu bạn Cập nhật dữ liệu theo đúng ngày tháng năm hiện tại, lấy dữ liệu từ đơn hàng sang ô màu xanh thì tại cột L, "hang" copy đến (Cell(hang, 10)):
if max(R[1]C10: R7C10) < Today() then
Cell(hang, 10) = Today()
End if ' Nếu = today thì sẽ bỏ qua.

 

[SA_DQ]

Xin cảm ơn nhiều!

Cho mình góp 1 câu:
Rng.Clear
vì Sub là Copy and delete mà chưa delete.

Đúng là thiếu 1 câu lệnh sau dòng lệnh 6 :

 Union(Rng, Range("F4")).ClearContents

Xin tri ân bạn!

 

[vumian]

SA_DQ ơi,
Giả sử mình muốn dùng vòng lặp chạy từ L7 và M7 xuống thì sao ạ ?

 

[SA_DQ]

Sao ưa vòng lặp thế không biết!?!

Giả sử mình muốn dùng vòng lặp chạy từ L7 và M7 xuống thì sao ạ ?

Thích thì chìu:
Nhưng tại L7 thì vẫn phải không vòng lặp, mà gán theo lệnh:

    Ngay = Range("F4") 
  If Ngay <> Range("L65432").End(xlUp) Then Clls.Offset(, -1) = Ngay

(Tất nhiên bạn có thể gán trực tiếp, vì ô F4 bạn luôn dùng để nhập ngày cho vùng dữ liệu mới!!)

Tiếp sau đó, bạn dùng vòng lặp dò từ E7..> F(i)
(Ở đây, i là dòng cuối của vùng dữ liệu bạn mới nhập)
vòng này chép từng dòng của 'Ej:Fj' sang nơi cư ngụ mới!

(Bạn thử làm theo mình diễn giải trên; Nếu không được mình sẽ cụ thể bằng tin nhắn!)
Chúc vui, nha!

 

[SA_DQ]

Đố vui về vòng lặp trong VBA

Giã dụ tôi có 9 ô liên tục theo hàng hay theo cột ( SuDoKu í mà)
(Hai đề chọn 1):

Đề I :Khi tôi nhập đến con số thừ 8,thì macro sẽ tự động nhập cho tôi con số còn lại vô ô còn trống còn lại
Đề 2: các chữ cái cần nhập là A, B, C, D, E, F, G, H, I (không theo trật tự).
Giải pháp gọn sẽ được động viên!

 

[tigertiger]

Giã dụ tôi có 9 ô liên tục theo hàng hay theo cột ( SuDoKu í mà)
(Hai đề chọn 1):

Đề I :Khi tôi nhập đến con số thừ 8,thì macro sẽ tự động nhập cho tôi con số còn lại vô ô còn trống còn lại
Đề 2: các chữ cái cần nhập là A, B, C, D, E, F, G, H, I (không theo trật tự).
Giải pháp gọn sẽ được động viên!

Rất hay, nhưng cong thắc mắc mấy điều bác ah?

oh, nếu là sodoku thì phải ô vuông 9x9 (và giới hạn các con số là số 1,2,..9) và có tổng bằng bao nhiêu nữa; chứ bác SA_DQ

và con số thứ 8 là sao? là 1,2,3...,8 số hay gì nhỉ?

-> Còn các chữ cái cũng thế còn 2 chữ -> còn hai ô 0 -> vậy điền theo tiêu chí nào (thứ tự) ra sao? nếu điền ngẫu nhiên thì dễ qua, thường ô chữ bị ràng buộc hàng ngang hàng dọc nữa,

 

[SA_DQ]

Vậy nè Tiger^2 à:
Trong trò chơi, thì đây là giai đoạn cuối của 1 hàng hay 1 cột; (gọi chung 1 dãy). Trước đó ta đã điền 7 trong 9 số từ 1-9 vô 7 ô bất kỳ rối. Khi ta tìm ra được số thừ 8 Và điền vô đúng ô thứ 8 mà nó cần phải an tọa, thì số thứ 9 còn lại duy nhất là số chưa có trong dãy đó sẽ được điền vô ô trống còn lại (!)
Chuyện này (là chuyện gán số cuối cùng còn lại này vô ô trống cuối cùng trong dẫy cần giao cho macro làm!

Hãy cho 1 giải pháp tối ưu khi sử dụng vòng lặp để làm cái chuyện không mấy hứng thú này!


Xin các Mod/SMod xóa bài này giúp sau 13h! Rất cám ơn!

 

[tigertiger]

Giải quyết 1) với số (1,2,...,9)

Với đặt name cho vùng (hàng /cột) dãy cuối cùng đó gồm 10 cells là: RgnHC (ứng với file của SA_DQ thì RgnHC = =Sheet1!$B$5:$J$5)
thì khi đó có thể sử dụng CODE sau

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  If (Not Intersect(Range("RgnHC"), Target) Is Nothing) _
       And Application.WorksheetFunction.CountBlank(Range("RgnHC")) = 1 Then
        Dim iJ As Integer, Cll As Range
        For Each Cll In Range("RgnHC")
            If Cll.Value = "" Then Cll.Value = 45 - Application.WorksheetFunction.Sum(Range("RgnHC"))
        Next
  End If
End Sub

chú ý: Nếu điền đủ rùi thì Muốn xóa thì phải xóa ít nhất 2 ô

 

[voda]

Đề 2 có thể giải như sau, các bạn cho ý kiến nhé:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Cll As Range
   Dim AdCll As String, MyStr As String
   MyStr = "ABCDEFGHI"
      If (Not Intersect(Range("RgnHC"), Target) Is Nothing) _
       And Application.WorksheetFunction.CountBlank(Range("RgnHC")) = 1 Then
             For Each Cll In Range("RgnHC")
               MyStr = Trim(Replace(MyStr, Cll.Value, " "))
               If Cll = "" Then AdCll = Cll.Address
            Next
               Range(AdCll) = MyStr
     End If
End Sub

 

[SA_DQ]

Theo mình cả hai cách giải quá chuẩn luôn!
Mình xin đề nghị các bạn thảo luận tiếp xem với With Cll . . . End With
Theo mình dùng thêm cái này có vẻ rườm rà, nhưng tăng tốc độ thực thi macro thì phải
( Có giống như trường hợp Từ phòng khách vô nhà bếp lấy con dao; Trở lại phòng khách, Sau đó vô nhà bếp lấy quả táo đem ra phòng khách để gọt.)
Tiger^2 ơi! Hình như bạn định dùng biến

iJ = Application.WorksheetFunction.Sum(Range("RgnHC"))

phải không; Hình như, vẫn là hình như thôi, thêm iJ vô vừa đẹp vừa tốt về mặt tốc độ hay sao í (?)
To VoDa: Nhập chữ thường vô là biết liền á!

(húc xuân vui vẽ!!

 

[tigertiger]

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If (Not Intersect(Range("RgnHC"), Target) Is Nothing) _
And Application.WorksheetFunction.CountBlank(Range("RgnHC")) = 1 Then
Dim iJ As Integer, Cll As Range
For Each Cll In Range("RgnHC")
If Cll.Value = "" Then Cll.Value = 45 - Application.WorksheetFunction.Sum(Range("RgnHC"))
Next
End If
End Sub

sửa lại thêm Exit For cho nhanh hơn, khi điền xong giá trị rồi thì thoát lun,

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  If (Not Intersect(Range("RgnHC"), Target) Is Nothing) _
       And Application.WorksheetFunction.CountBlank(Range("RgnHC")) = 1 Then
        Dim iJ As Integer, Cll As Range
        For Each Cll In Range("RgnHC")
            If Cll.Value = "" Then 
                   Cll.Value = 45 - Application.WorksheetFunction.Sum(Range("RgnHC"))
                  Exit For
            End If
        Next
  End If
End Sub

Nên đặt cột vào trong IF
If (Not Intersect(Range("RgnHC"), Target) Is Nothing) _
And Application.WorksheetFunction.CountBlank(Range("RgnHC")) = 1 Then
<...............>
End If

Vì sự kiện này lun được khỏi khi có sheet có sự kiện thay đổi

Sửa lại như sau:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) 

If (Not Intersect(Range("RgnHC"), Target) Is Nothing) _
       And Application.WorksheetFunction.CountBlank(Range("RgnHC")) = 1 Then
       Dim Cll As Range
    Dim AdCll As String, MyStr As String
    MyStr = "ABCDEFGHI"
                 For Each Cll In Range("RgnHC")     
        MyStr = Trim(Replace(MyStr, Cll.Value, " "))
        If Cll = "" Then AdCll = Cll.Address
    Next
    Range(AdCll) = MyStr
     End If
End Sub

 

[minhlev]

To VoDa: Nhập chữ thường vô là biết liền á!

Để tránh trường hợp như bác SA_DQ nói thì em sửa dòng code thứ 7 của bác Voda

               MyStr = Trim(Replace(MyStr, Cll.Value, " "))

thành

               MyStr = Trim(Replace(MyStr, Ucase(Cll.Value), " "))

Sau khi sửa thấy chạy vẫn Ok. Không biết em nói đúng ý bác SA_DQ hay không????

 

[SA_DQ]

Có thể hay không thể?

Có thể sửa đoạn mã của VoDa thành trường hợp tổng quát cho ký số (của Tiger^2) & ký tự không các bạn nhỉ?!

 

[tigertiger]

Có thể sửa đoạn mã của VoDa thành trường hợp tổng quát cho ký số (của Tiger^2) & ký tự không các bạn nhỉ?!

Mọi điều đều có thể chứ,

+ Với trường hợp số, Lúc này biến
MyStr = "ABCDEFGHI"
thành chuỗi ký tự số
+ Khi Ktra thì loại thành "" thì
trong lệnh này MyStr = Trim(Replace(MyStr, Cll.Value, " "))
Cll.Value -> thành Trim(Str(Cll.Value))

là được

Mở rộng:
Nhưng tổng quát hơn nữa thì nên phân biệt giữa các ký tự này bằng dấu " " như
MyStr = "A B C D E F G H I "

Khi đó có thể là 2, 3,... ký tự hoặc chữ số trong 1 ô


Tuy nhiên theo TigerTiger
Thì với số chúng ta dùng cách SUM sẽ nhanh hơn -


Cuối cùng với nx gợi ý như vậy, với các code ở post trước -> Các bạn thử sức xem sao (theo ý bác SA nhỉ)
.