Chuyên mục xử lý, gỡ rối code VBA (2 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Status
Không mở trả lời sau này.
ndu96081631

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia
5/6/08
Bài viết
30,703
Được thích
53,957
Sắp xếp theo thời gian sắp xếp theo bầu chọn
befaint đã viết:
Trước tiên, bạn cần sửa lại yêu cầu của bạn đã. Bạn biểu đạt làm sao để người khác hiểu trúng yêu cầu của mình. Tôi mới chỉ là đoán ý theo bài #647.
Nhấp chuột vào đây để mở rộng...

Befaint đoán đúng ý mính rồi. Ban đầu lệnh để chuyển dữ liệu mảng vào sheet trong chính file đó. Nhưng nếu chuyển dữ liệu mảng đó vào một file khác thì thay đổi như thế nào?
 
Lần chỉnh sửa cuối:
Upvote 0
À được rồi cảm ơn Befaint nhé, hóa ra khi chạy lệnh phải acticve file Gốc (file số 1), mình active file chuyển đến (File số 2) chạy toàn báo lỗi.
 
Upvote 0
Nhờ tối ưu đoạn code paste special

Mình có 1 đoạn code hoàn chỉnh tuy nhiên cần tối ưu nên nhờ các bạn giúp đỡ

======
Sub chay()
Dim dongcuoi1 As Long
Dim dongcuoi2 As Long
dongcuoi1 = Worksheets("0").Range("P" & Rows.Count).End(xlUp).Row
Range("D2:O2").Select
Selection.AutoFill Destination:=Range("D2:O" & dongcuoi1)
Columns("D:F").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=False
Range([F2], [F1048576].End(xlUp)).Copy [C2]
Range([E2], [E1048576].End(xlUp)).Copy [C1048576].End(xlUp).Offset(1)
Range([D2], [D1048576].End(xlUp)).Copy [C1048576].End(xlUp).Offset(1)
Range([C2], [C1048576].End(xlUp)).RemoveDuplicates Columns:=1
dongcuoi2 = Worksheets("0").Range("C2").End(xlDown).Row
Range("A2:B2").Select
Selection.AutoFill Destination:=Range("A2:B" & dongcuoi2&)
Cells.Select
ActiveWorkbook.Save
Range("A1").Select
Range("A1", Range("A2").End(xlDown)).Select
Selection.Copy
End Sub
======
Ở phần code này(bên dưới):
=====
Columns("D:F").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=False
Range([F2], [F1048576].End(xlUp)).Copy [C2]
Range([E2], [E1048576].End(xlUp)).Copy [C1048576].End(xlUp).Offset(1)
Range([D2], [D1048576].End(xlUp)).Copy [C1048576].End(xlUp).Offset(1)

=====
Mình đang thực hiện select từ cột D đến cột F sau đó thực hiện Copy Paste Special Values lại rồi mới thực hiện nhập các dữ liệu có ở cột D, cột E, Cột F lại vào chung cột C
mình muốn cái tiến việc này bằng cách bỏ việc phải Copy Paste Special Values ở cột D đến F đi mà thực hiện nhập dữ liệu có ở cột D, E, F vào cột C luôn với việc khi paste sẽ là Paste Special Values
Anh em giúp mình với.
 

File đính kèm

Upvote 0
thangteo đã viết:
Em xin mạn phép gửi nội dung này sang bên chuyên mục này để nhờ các anh sửa giúp:
------------------------
Sau khi em test thử file của anh huuthang_bd (dưới file đính kèm) thì có một số vấn đề sau ạ, và mong các anh ai có thời gian thì chỉnh sửa code giúp em với:
1. Lỗi: Thời gian nghỉ giữa 2 Hiệp khi đang chạy mà nhấn Enter thì lại chạy lại từ đầu như kiểu reset ấy ạ. Lỡ may mà nhấn Enter phát thì thời gian nhỉ lại chạy dài thêm mất.
2. Thêm: một số nút nhấn trực tiếp trên bảng điểm như hình dưới ạ:
- 2 nút cộng và trừ ở mục Nhắc nhở. Phần này sẽ bỏ phím tắt 5 và 0 đi ạ, thay vào đó sẽ nhấn trực tiếp trên bảng chấm điểm. Mỗi lần nhấn là cộng là 1 lần nhắc nhở, nút trừ để phòng khi số lần nhắc nhở bị nhầm và cũng trừ đi 1. Luật nhắc nhở vẫn vậy: 3 lần nhắc nhở tương đương 1 lần cảnh cáo và trừ 1 điểm, 6 lần nhắc nhở tương đương 2 lần cảnh cáo trừ 2 điểm, 9 lần nhắc nhở tương đương 3 lần cảnh cáo trừ 3 điểm và truất quyền thi đấu.
- 2 nút cộng trừ ở mục Điểm. Phần này để cộng hoặc trừ điểm VĐV khi trọng tài chính quyết định, mỗi lần nhấn tương đương cộng 1 điểm hoặc trừ 1 điểm, và cũng để phòng khi số điểm lớn được chỉnh sửa lại cho chính xác theo quyết định trọng tài chính.


- Phím Enter để bắt đầu trận đấu, nhờ các anh thêm phím "dấu cách" để dừng hoặc tiếp tục trận đấu khi trận đấu đang diễn ra ạ.
3. Thay đổi các phím tắt bấm điểm cho VĐV:
- "Như hiện tại thì hình dung tay cầm bấm nút có 2 nút: khi VĐV xanh hoặc đỏ được 1 điểm thì trọng tài bấm nút xanh hoặc đỏ 1 lần, khi được 2 điểm thì bấm đúp nút xanh hoặc đỏ 2 lần."
- Bây giờ thay đổi tay cầm bấm nút có 4 nút như hình thế này:

Mô tả:
- Mỗi tay cầm có 2 nút xanh và 2 nút đỏ. Xanh có: một nút 1 điểm và 1 nút 2 điểm. Đỏ có: 1 nút 1 điểm và 1 nút 2 điểm => Tổng 16 nút bấm cho 4 tay cầm.
- Gán vào các phím tắt trên bàn phím như hình trên:
+ Tay cầm 1: Đỏ: 1 điểm = phím 0, 2 điểm = phím 1. Xanh: 1 điểm = phím 2, 2 điểm = phím 3.
+ Tay cầm 2: Đỏ: 1 điểm = phím 4, 2 điểm = phím 5. Xanh: 1 điểm = phím 6, 2 điểm = phím 7.
+ Tay cầm 3: Đỏ: 1 điểm = phím 8, 2 điểm = phím 9. Xanh: 1 điểm = phím F1, 2 điểm = phím F2.
+ Tay cầm 4: Đỏ: 1 điểm = phím F3, 2 điểm = phím F4. Xanh: 1 điểm = phím F5, 2 điểm = phím F6.
- Việc thêm nút ở tay cầm và gán tất cả các nút vào phím tắt trên bàn phím để thay thế việc nhấn đúp 2 lần khi cho 2 điểm, tránh trường hợp nhấn đúp không thành công.
- Vấn đề 4 ô: 1, 2, 3, 4 ở dọc 2 bên điểm lớn vẫn sáng khi trọng tài bấm nút 1 điểm hoặc 2 điểm ạ. Vấn đề này để xác định trọng tài nào nhấn nút và trọng tài nào không nhấn nút ạ.
--------------------
Vì em không hiểu gì về code VBA cả nên rất mong nhận được sự giúp đỡ của các anh. Cảm ơn ạ!
Nhấp chuột vào đây để mở rộng...

Nhờ các bác giành thời gian hỗ trợ giúp đỡ em với ạ!
 
Upvote 0
DINODRAGON đã viết:
Mình có 1 đoạn code hoàn chỉnh tuy nhiên cần tối ưu nên nhờ các bạn giúp đỡ

======
Sub chay()
Dim dongcuoi1 As Long
Dim dongcuoi2 As Long
dongcuoi1 = Worksheets("0").Range("P" & Rows.Count).End(xlUp).Row
Range("D2:O2").Select
Selection.AutoFill Destination:=Range("D2:O" & dongcuoi1)
Columns("D:F").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=False
Range([F2], [F1048576].End(xlUp)).Copy [C2]
Range([E2], [E1048576].End(xlUp)).Copy [C1048576].End(xlUp).Offset(1)
Range([D2], [D1048576].End(xlUp)).Copy [C1048576].End(xlUp).Offset(1)
Range([C2], [C1048576].End(xlUp)).RemoveDuplicates Columns:=1
dongcuoi2 = Worksheets("0").Range("C2").End(xlDown).Row
Range("A2:B2").Select
Selection.AutoFill Destination:=Range("A2:B" & dongcuoi2&)
Cells.Select
ActiveWorkbook.Save
Range("A1").Select
Range("A1", Range("A2").End(xlDown)).Select
Selection.Copy
End Sub
======
Ở phần code này(bên dưới):
=====
Columns("D:F").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=False
Range([F2], [F1048576].End(xlUp)).Copy [C2]
Range([E2], [E1048576].End(xlUp)).Copy [C1048576].End(xlUp).Offset(1)
Range([D2], [D1048576].End(xlUp)).Copy [C1048576].End(xlUp).Offset(1)

=====
Mình đang thực hiện select từ cột D đến cột F sau đó thực hiện Copy Paste Special Values lại rồi mới thực hiện nhập các dữ liệu có ở cột D, cột E, Cột F lại vào chung cột C
mình muốn cái tiến việc này bằng cách bỏ việc phải Copy Paste Special Values ở cột D đến F đi mà thực hiện nhập dữ liệu có ở cột D, E, F vào cột C luôn với việc khi paste sẽ là Paste Special Values
Anh em giúp mình với.
Nhấp chuột vào đây để mở rộng...
Bạn thế bằng đoạn code
Mã: 
[C2].Resize(Range([F2], [F1048576].End(xlUp)).Rows.Count).Value = Range([F2], [F1048576].End(xlUp)).Value
[C1048576].End(xlUp).Offset(1).Resize(Range([E2], [E1048576].End(xlUp)).Rows.Count).Value = Range([E2], [E1048576].End(xlUp)).Value
[C1048576].End(xlUp).Offset(1).Resize(Range([D2], [D1048576].End(xlUp)).Rows.Count).Value = Range([D2], [D1048576].End(xlUp)).Value
 
Upvote 0
Chào các anh (chị) hiện nay em có 1 đoạn mã VBA đã viết (nói chung là chạy tốt) nhưng do số liệu bảng tra quá dài (trên 50000 dòng) nên đoạn code phát huy không hiệu quả.
Chạy rất chậm và bị giật.
Nhờ các anh chị chỉnh lại giúp em đoạn code sau. Em xin chân thành cám ơn

Sub bienban()
On Error Resume Next
Dim sh1 As Worksheet ' Sheet DMCVNT
Dim Rng1 As Range
Dim STT_BBNT As Range
Dim STT_BB As Range
Dim STT_BBCV As Range
Dim VT_DTNT As Range
Dim VT_NDTCV As Range
Dim VT_TCV As Range
Dim VT_TCAD As Range
Dim VT_KTCV As Range
Dim sodongcp As Integer
Dim I As Integer
Dim bb As Integer
Dim SoBienBan As Integer
For bb = 1 To DMCVNT.Range("SoBB") 'So bien ban
Application.Interactive = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlManual
MBBNTNBCV.Copy before:=Sheets(bb)
Range("K5") = bb
'*******Dua so lieu tu bang Danh muc cong viec nghiem thu sang Bien ban nghiem thu ***************
Set STT_BB = Range("K5")
Set VT_DTNT = Sheets(bb).Cells.Find(What:="dtnt", After:=ActiveCell, LookIn:=xlComments, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
Set VT_TCV = Sheets(bb).Cells.Find(What:="TCV", After:=ActiveCell, LookIn:=xlComments, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
Set VT_NDTCV = Sheets(bb).Cells.Find(What:="NDKT", After:=ActiveCell, LookIn:=xlComments, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
Set VT_TCAD = Sheets(bb).Cells.Find(What:="TCAD", After:=ActiveCell, LookIn:=xlComments, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
Set VT_KTCV = Sheets(bb).Cells.Find(What:="KTCV", After:=ActiveCell, LookIn:=xlComments, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
Set Rng1 = Range(DMCVNT.[A6], DMCVNT.[A65500].End(xlUp))
Set STT_BBCV = Rng1.Find(STT_BB, , xlFormulas, xlWhole)
If STT_BBCV Is Nothing Then
VT_DTNT.Offset(0, 0).Font.ColorIndex = 3
Else
'Chen dong bien ban
Range(STT_BBCV.Offset(0, 17), STT_BBCV.End(xlDown).Offset(-1, 50)).Copy
VT_DTNT.Offset(1, 0).EntireRow.Insert
Range(STT_BBCV.Offset(0, 17), STT_BBCV.End(xlDown).Offset(-1, 50)).Copy
VT_TCV.Offset(1, 0).EntireRow.Insert
Range(STT_BBCV.Offset(0, 17), STT_BBCV.End(xlDown).Offset(-2, 50)).Copy
VT_TCAD.Offset(1, 0).EntireRow.Insert
Range(STT_BBCV.Offset(0, 17), STT_BBCV.End(xlDown).Offset(-1, 50)).Copy
VT_NDTCV.Offset(1, 0).EntireRow.Insert
'Copy so thu tu
Range(STT_BBCV.Offset(0, 1), STT_BBCV.End(xlDown).Offset(-1, 1)).Copy
VT_DTNT.Offset(1, 0).PasteSpecial (xlPasteValues)
VT_TCAD.Offset(1, 0).PasteSpecial (xlPasteValues)
VT_NDTCV.Offset(1, 0).PasteSpecial (xlPasteValues)
VT_TCV.Offset(1, 0).PasteSpecial (xlPasteValues)
'Ma hieu cong viec
Range(STT_BBCV.Offset(0, 2), STT_BBCV.End(xlDown).Offset(-2, 2)).Copy
VT_TCAD.Offset(1, -2).PasteSpecial (xlPasteValues)
VT_TCAD.Offset(1, 14).PasteSpecial (xlPasteValues)
VT_NDTCV.Offset(1, -3).PasteSpecial (xlPasteValues)
'Copy ten cong viec
Range(STT_BBCV.Offset(0, 3), STT_BBCV.End(xlDown).Offset(-1, 3)).Copy
VT_DTNT.Offset(1, 1).PasteSpecial (xlPasteValues)
VT_TCV.Offset(1, 1).PasteSpecial (xlPasteValues)
VT_NDTCV.Offset(1, 1).PasteSpecial (xlPasteValues)
VT_TCAD.Offset(1, 1).PasteSpecial (xlPasteValues)
'Copy don vi
Range(STT_BBCV.Offset(0, 4), STT_BBCV.End(xlDown).Offset(-1, 4)).Copy
VT_TCV.Offset(1, 8).PasteSpecial (xlPasteValues)
'Khoi luong cong viec
Range(STT_BBCV.Offset(0, 5), STT_BBCV.End(xlDown).Offset(-2, 5)).Copy
VT_TCV.Offset(1, 9).PasteSpecial (xlPasteValues)
Range(STT_BBCV.Offset(0, 6), STT_BBCV.End(xlDown).Offset(-2, 6)).Copy
VT_TCV.Offset(1, 11).PasteSpecial (xlPasteValues)
'Ke bang noi dung kiem tra
Range(VT_NDTCV.Offset(0, 1), VT_TCV.Offset(-3, 12)).Select
End If

'Dien ki hieu nhan biet noi dung kiem tra ten cong viec
For I = 11 To 500
If Cells(I, "A") <> "" Then
Cells(I, "B") = ":" & Cells(I, "A")
End If
Next I
'***** Chen cac noi dung tieu chuan va noi dung kiem tra cong viec ******
' Khai báo
Range("B7").End(xlDown).Select
Dim Sh As Worksheet, Rng As Range, sRng As Range, XX As Range
Set Sh = Workbooks("TCVN.xla").Worksheets("TCNTCV")
Set Rng = Sh.Range(Sh.[C2], Sh.[C65500].End(xlUp))


'Tra du lieu tao bang CMPT
Do Until Selection = ""
Set XX = Selection
Set sRng = Rng.Find(XX, , xlFormulas, xlWhole)
If sRng Is Nothing Then
Selection.Font.ColorIndex = 3
Selection.Offset(1, 0).Select
Selection.EntireRow.Insert
Selection.End(xlDown).Select
Else
Range(sRng.Offset(0, 0), sRng.End(xlDown).Offset(-1, 0)).EntireRow.Copy
Selection.Offset(1, -1).Insert Shift:=xlDown
Selection.ClearContents
Selection.End(xlDown).Select
End If
Loop
Application.CutCopyMode = False
Range("A1").Select
Sheets(bb).Name = "NTNBCV" & bb
'Dinh dang bang bieu
Dim x As Integer
For x = 11 To 500
If Cells(x, "A") <> "" Then
Range(Cells(x, "D"), Cells(x, "P")).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.WrapText = True
.MergeCells = False
.Font.Bold = True
.Font.Italic = True
End With
End If
If Cells(x, "R") <> "" Then
Cells(x, "D").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = True
'.Font.Bold = True
.Font.Italic = True
End With
Range(Cells(x, "E"), Cells(x, "P")).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.MergeCells = True
'.Font.Bold = True
.Font.Italic = True
End With
End If


'Ke bang khoi luong
Range(VT_TCV.Offset(1, 0), VT_KTCV.Offset(-2, 0)).Select
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
Selection.NumberFormat = "General"
'Ke chan bang noi dung nghiem thu
Range(VT_TCV.Offset(-4, 0), VT_TCV.Offset(-4, 12)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("D1").Select
Next x
'Tao bien ban tiep theo
Next bb
Application.Interactive = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets(1).Select
Set STT_BB = Nothing
Set VT_DTNT = Nothing
Set VT_TCV = Nothing
Set VT_NDTCV = Nothing
Set VT_TCAD = Nothing
Set Rng1 = Nothing
Set STT_BBCV = Nothing
Set Sh = Nothing
Set Rng = Nothing
Set XX = Nothing
Set sRng = Nothing
End Sub
 
Upvote 0
Nhờ các anh bổ xung phím "dấu cách" để dừng và tiếp tục thời gian thi đấu với ạ:
----------------------------
Cái này bên Module:
Private Sub DisplayTimer()
Dim i As Long
If Min = 0 And Sec <= 1 Then
Display_Off
SubBeep
iArrTimeInfo = iArrTimeInfo + 1
If iArrTimeInfo <= UBound(ArrTimeInfo, 2) Then
BangDiem.LB_ThoiGian.Caption = ArrTimeInfo(1, iArrTimeInfo) & ":" & Format(ArrTimeInfo(2, iArrTimeInfo), "00")
If Round(iArrTimeInfo Mod 2, 0) = 0 Then
Display_On
Else
BangDiem.LB_Hiep.Caption = ThongTin.Range(Hiep).Value & " " & Round((iArrTimeInfo + 1) / 2, 0)
BangDiem.LB_TrangThai.Caption = ThongTin.Range(SanSang).Value
End If
Else
BangDiem.LB_ThoiGian.Caption = "0:00"
BangDiem.LB_TrangThai.Caption = ThongTin.Range(KetThuc).Value
BangDiem.CB_DangThiDau.Value = False
End If
Exit Sub
ElseIf Sec = 0 And Min > 0 Then
Sec = 59: Min = Min - 1
Else
Sec = Sec - 1
End If
BangDiem.LB_ThoiGian.Caption = Min & ":" & Format(Sec, "00")
End Sub
-------------------------------
Cái này là bên Forms: (đã gán nhấn phím Enter (13) chạy thời gian rồi).
Private Sub TB_NhanTinHieu_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If Not Me.CB_DangThiDau.Value Then
If KeyCode = 13 Then
If iArrTimeInfo <= UBound(ArrTimeInfo, 2) Then
Me.CB_DangThiDau.Value = True
Display_On
End If
End If
End If
Select Case KeyCode
Case TT1D
Me.LB_TT1_Do.BackColor = BackColor0
Case TT2D
Me.LB_TT2_Do.BackColor = BackColor0
Case TT3D
Me.LB_TT3_Do.BackColor = BackColor0
Case TT4D
Me.LB_TT4_Do.BackColor = BackColor0
Case TT1X
Me.LB_TT1_Xanh.BackColor = BackColor0
Case TT2X
Me.LB_TT2_Xanh.BackColor = BackColor0
Case TT3X
Me.LB_TT3_Xanh.BackColor = BackColor0
Case TT4X
Me.LB_TT4_Xanh.BackColor = BackColor0
Case 27
Unload Me
End Select
KeyCode = 0
End Sub
--------------------------
Em không biết về code VBA nên nếu cần rõ hơn các anh lấy file về xem cho kỹ ở bài #640.
Rất mong các anh bớt chút thời gian giúp đỡ ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
HieuCD đã viết:
Bạn thế bằng đoạn code
Mã: 
[C2].Resize(Range([F2], [F1048576].End(xlUp)).Rows.Count).Value = Range([F2], [F1048576].End(xlUp)).Value
[C1048576].End(xlUp).Offset(1).Resize(Range([E2], [E1048576].End(xlUp)).Rows.Count).Value = Range([E2], [E1048576].End(xlUp)).Value
[C1048576].End(xlUp).Offset(1).Resize(Range([D2], [D1048576].End(xlUp)).Rows.Count).Value = Range([D2], [D1048576].End(xlUp)).Value
Nhấp chuột vào đây để mở rộng...

Mình không thấy nút thank để gửi bạn một Like!. Cám ơn bạn rất nhiều.
 
Upvote 0
Giúp tối ưu thêm lần nữa

Mình muốn tối ưu thêm ở đoạn code này
=======
dongcuoi1 = Worksheets("0").Range("Z" & Rows.Count).End(xlUp).Row
Range("D2:O2").Select
Selection.AutoFill Destination:=Range("D2:O" & dongcuoi1)
=====

mình đang sử dụng số dòng tại cột Z để làm căn cứ cho lệnh autofill ở dưới tuy nhiên mình muốn so sánh thêm giữa 3 cột là cột P, cột U và cột Z, cột nào có số dòng lớn nhất thì sẽ căn cứ vào số dòng của cột đó mà autofill
Bạn giúp mình với


=======================
Sub chay()
Dim dongcuoi1 As Long
Dim dongcuoi2 As Long
dongcuoi1 = Worksheets("0").Range("Z" & Rows.Count).End(xlUp).Row
Range("D2:O2").Select
Selection.AutoFill Destination:=Range("D2:O" & dongcuoi1)
[C2].Resize(Range([F2], [F1048576].End(xlUp)).Rows.Count).Value = Range([F2], [F1048576].End(xlUp)).Value
[C1048576].End(xlUp).Offset(1).Resize(Range([E2], [E1048576].End(xlUp)).Rows.Count).Value = Range([E2], [E1048576].End(xlUp)).Value
[C1048576].End(xlUp).Offset(1).Resize(Range([D2], [D1048576].End(xlUp)).Rows.Count).Value = Range([D2], [D1048576].End(xlUp)).Value
Range([C2], [C1048576].End(xlUp)).RemoveDuplicates Columns:=1
dongcuoi2 = Worksheets("0").Range("C2").End(xlDown).Row
Range("A2:B2").Select
Selection.AutoFill Destination:=Range("A2:B" & dongcuoi2&)
Cells.Select
ActiveWorkbook.Save
Range("A1").Select
Range("A1", Range("A2").End(xlDown)).Select
Selection.Copy
End Sub
 
Upvote 0
DINODRAGON đã viết:
mình đang sử dụng số dòng tại cột Z để làm căn cứ cho lệnh autofill ở dưới tuy nhiên mình muốn so sánh thêm giữa 3 cột là cột P, cột U và cột Z, cột nào có số dòng lớn nhất thì sẽ căn cứ vào số dòng của cột đó mà autofill
Nhấp chuột vào đây để mở rộng...

Mã: 
Dim lr As Long
lr = Worksheets("0").Range("U2:Z2").End(xlDown).Row

p/s: Code thì vui lòng cho vào thẻ
Mã: 
 hoặc [php]

[COLOR=#ffffff]Cái trang này dài quá thể là dài!!!![/COLOR]
 
Upvote 0
Cám ơn bạn
Mình sẽ rút kinh nghiệm lần sau đưa vào thẻ code
Nhưng code bạn đưa ra cho vào nó không chạy được.
 
Upvote 0
Mình đã tự giải được rồi, cám ơn các bạn nhiều
Mã: 
[/COLOR]
Sub chay()
Dim dongcuoi1 As Long
Dim dongcuoi2 As Long
Dim cp As Long
Dim cu As Long
Dim cz As Long
cp = Worksheets("0").Range("P" & Rows.Count).End(xlUp).Row
cu = Worksheets("0").Range("U" & Rows.Count).End(xlUp).Row
cz = Worksheets("0").Range("Z" & Rows.Count).End(xlUp).Row
dongcuoi1 = cp
If dongcuoi1 < cu Then dongcuoi1 = cu
If dongcuoi1 < cz Then dongcuoi1 = cz
Range("D2:O2").Select
Selection.AutoFill Destination:=Range("D2:O" & dongcuoi1)
[C2].Resize(Range([F2], [F1048576].End(xlUp)).Rows.Count).Value = Range([F2], [F1048576].End(xlUp)).Value
[C1048576].End(xlUp).Offset(1).Resize(Range([E2], [E1048576].End(xlUp)).Rows.Count).Value = Range([E2], [E1048576].End(xlUp)).Value
[C1048576].End(xlUp).Offset(1).Resize(Range([D2], [D1048576].End(xlUp)).Rows.Count).Value = Range([D2], [D1048576].End(xlUp)).Value
Range([C2], [C1048576].End(xlUp)).RemoveDuplicates Columns:=1
dongcuoi2 = Worksheets("0").Range("C2").End(xlDown).Row
Range("A2:B2").Select
Selection.AutoFill Destination:=Range("A2:B" & dongcuoi2&)
Cells.Select
ActiveWorkbook.Save
Range("A1").Select
Range("A1", Range("A2").End(xlDown)).Select
Selection.Copy
End Sub
[COLOR=#000000]
 
Upvote 0
Đồng hồ đếm ngược:
Em có file:
http://www.mediafire.com/file/brvw4uljyl2d70r/Dong+ho+dem+nguoc.xlsm

Em học được cách tạo đồng hồ đếm ngược từ anh @Thanh Ngoc Pham trên Youtube: https://www.youtube.com/watch?v=fi5b1iEFrwE
Nhưng có 1 vấn đề là: đồng hồ chỉ chạy khi không có ô excel nào active, khi nhập liệu vào ô cell thì đồng hồ dừng.
Các thầy cô, a/c có hướng nào để xử lý vấn đề này giúp em với ạ: đồng hồ vẫn chạy trong khi thao tác nhập liệu vẫn bình thường.
Em xin chân thành cảm ơn ạ!

P/s: với VBA em chỉ mới biết record macro, đọc hiểu vài code rất đơn giản thôi ạ ~~
 
Upvote 0
ducanh010 đã viết:
Đồng hồ đếm ngược:
Em có file:
http://www.mediafire.com/file/brvw4uljyl2d70r/Dong+ho+dem+nguoc.xlsm

Em học được cách tạo đồng hồ đếm ngược từ anh @Thanh Ngoc Pham trên Youtube: https://www.youtube.com/watch?v=fi5b1iEFrwE
Nhưng có 1 vấn đề là: đồng hồ chỉ chạy khi không có ô excel nào active, khi nhập liệu vào ô cell thì đồng hồ dừng.
Các thầy cô, a/c có hướng nào để xử lý vấn đề này giúp em với ạ: đồng hồ vẫn chạy trong khi thao tác nhập liệu vẫn bình thường.
Em xin chân thành cảm ơn ạ!

P/s: với VBA em chỉ mới biết record macro, đọc hiểu vài code rất đơn giản thôi ạ ~~
Nhấp chuột vào đây để mở rộng...

---------------------
Thử file này xem có ổn không anh!
 

File đính kèm

Upvote 0
DINODRAGON đã viết:
Cám ơn bạn nhiều, nhờ dòng code này mình lại nghĩ thêm được vài cái hay ho nữa
Nhấp chuột vào đây để mở rộng...

Thử file này xem sao nhé
Lưu ý trong code có đoạn:
Mã: 
Public Const s3 = "00:00:15"
Đây là giá trị bắt đầu của đồng hồ đếm ngược. Ở đây tôi đặt nó = 15s, muốn khác hơn hãy sửa lại nhé
 

File đính kèm

Upvote 0
Status
Không mở trả lời sau này.
Web KT

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

N
  • Question Question
Nhờ mọi người góp ý cho file Quản lý bán hàng viết bằng VBA đầu tay của mình (6 người xem)
    • Cảm ơn
Trả lời
6
Đọc
72
VetMini
V
S
NHỜ ANH EM GIÚP MÌNH TÌM KIẾM DỮ LIỆU (3 người xem)
Trả lời
1
Đọc
5
snow25
snow25
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
15 16 17
Trả lời
326
Đọc
24K
pycckuu410
P
HeSanbi
  • Question Question
Sự khác nhau giữa book.Worksheets và book.Sheets trong Application (2 người xem)
    • Thích
Trả lời
1
Đọc
84
VetMini
V
V
  • Question Question
Đếm xếp loại của đơn hàng (2 người xem)
Trả lời
8
Đọc
164
vanlinh_2904
V
J
Công thức tính lương khi mỗi tháng tăng lương cơ bản (2 người xem)
Trả lời
2
Đọc
64
jangne88
J
H
Xin được trợ giúp lỗi máy không mở được cửa sổ VBE.
Trả lời
0
Đọc
27
HUONGHCKT
H
phatnguyen7301
  • Question Question
Viết code không trùng dữ liệu
Trả lời
3
Đọc
99
VetMini
V
HeSanbi
  • Question Question
GPEStudio - Ứng dụng hỗ trợ tương tác giữa Excel và diễn đàn GPE
    • Thích
Trả lời
0
Đọc
76
HeSanbi
HeSanbi
yeudoi
Cà phê giao lưu cùng thành viên kỳ cựu Cao Mạnh Sơn 19h 23/2/2025
    • Thích
Trả lời
0
Đọc
39
yeudoi
yeudoi
HeSanbi
  • Question Question
FlashSheet v1.1 - Di chuyển qua lại tức thời giữa các trang tính (2 người xem)
    • Thích
    • Yêu thích
Trả lời
3
Đọc
595
HeSanbi
HeSanbi
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
6
Đọc
223
HeSanbi
HeSanbi
Manhhung90
Thoát chế độ Read only file word. Nhờ mọi người giúp ạ
Trả lời
5
Đọc
91
Manhhung90
Manhhung90
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng theo điều kiện cho trước.
Trả lời
3
Đọc
97
hanhnguyen12022021
H
N
Không chạy được file VBA
Trả lời
2
Đọc
99
hoangtuan.net
hoangtuan.net
H
Quản Lý Công Văn đi Và đến
9 10 11
Trả lời
214
Đọc
159K
ptm0412
ptm0412
T
Em muốn xin chỉ giáo file excel theo dõi thu chi, lãi lỗ của từng xe để báo cáo ạ
Trả lời
3
Đọc
101
VetMini
V
S
RemoveDuplicates Adodb VBA (1 người xem)
Trả lời
0
Đọc
76
sykika
S
G
  • Question Question
BẢO MẬT VBAPROJECT (1 người xem)
Trả lời
0
Đọc
133
giaoluu1231
G
sangvanng92
  • Question Question
Phân quyền user truy cập
Trả lời
9
Đọc
196
Hoàng Tuấn 868
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom