Có ai không?
Xem kết quả mẫu mà vẫn không hiểu dữ liệu kết quả từ đâu có.
File của em nặng quá không tải lên được, dữ liệu thì lấy ở 5 sheet khác nhưng chỉ có dữ liệu trung ở 3 sheet em nói ở trên. Hiện tại thì mỗi lần chạy xong là em phải chạy thêm 1 macro để lọc dữ liệu trùng nữa nên hơi mất thời gian nên em muốn viết thêm vào phần lấy dữ liệu để chạy 1 lần là có kết quả luôn. Anh có mail không em gửi qua mail cho anh để xem cho rõ hơn.
Anh ơi, anh xem hộ em file đính kèm, hiện tại ở cột mã vật tư có 2 mã là KEEX03_MDO là trùng nhau, bây giờ em muốn xóa dòng KEEX03_MDO có mã bề mặt là "_" thì làm thế nào ạ. Em cảm ơn.
sub news()
'
If vianboolean = True Then Exit Sub
' code
Application.OnTime Now + TimeValue("00:10:00"), "News"
end subPrivate Sub CommandButton1_Click()
vianboolean = True
ens subSub viannews()
vianboolean = False
Call News
End Sub
Bỏ .Value đi thì hết lỗi dòng đó nhưng mấy dòng dưới lỗi tiếp...
Function Tich(StrC As String) As Double
Dim VTr As Byte, GPE As Double, COM As Double
VTr = InStr(StrC, "x")
If VTr Then
GPE = CDbl(Left(StrC, VTr - 1))
StrC = Mid(StrC, VTr + 1, Len(StrC))
COM = CDbl(Left(StrC, Len(StrC) - 1))
Tich = GPE * COM
End If
End FunctionVâng anh, copy mã nhân viên và tên nhân viên từ sheet BangLuong của PXKhoang_2017 vào sheet BangLuong của PXKhoan_Test. À anh cho em hỏi thêm là, bây giờ em có 10 file của mỗi phân xưởng riêng thì có cách nào chạy 1 lần mà tự động copy theo từng phân xưởng không anh. Hiện tại mỗi phân xưởng nằm cùng một thư mục quản lý và chia ra từng thư mục theo phân xưởng. Có một vấn đề nữa là 2 file cần copy dữ liệu không nằm trong một thư mục, như hình ở dưới thì dữ liệu cần copy nằm trong các phân xưởng, còn file để paste dữ liệu thì nằm trong thư mục Templates anh ạ.
sếp em yêu cầu là phải làm băng marco anh ạ.
Sếp của em thì không có ở trên này anh ạ, bởi vì cái này hàng tháng em đều phải copy 1 lần. Sau khi copy xong thì có đoạn macro đẩy kế hoạch cho các phân xưởng nữa nên làm tự động thì hay hơn ạ.
Trên bảng mô tả công việc của bạn có mục nào ghi kiểu như "thực hiện các công việc trên excel bằng macro" không
Sếp em viết là: "Viết macro update mã và tên nhân viên vào template kế hoạch sản xuất của PX" anh ạ.Trên bảng mô tả công việc của bạn có mục nào ghi kiểu như "thực hiện các công việc trên excel bằng macro" không
Em thấy làm bằng macro cũng thuận tiện hơn mà anh. Sếp giao thì em làm thôi. Thôi để em tự nghiên cứu, em cảm ơn anh.
Thế bạn trả lời sao???thanhnt1910 said: ↑
Sếp em viết là: "Viết macro update mã và tên nhân viên vào template kế hoạch sản xuất của PX" anh ạ.
Ghi trên bảng mô tả công việc (khi tuyển dụng) khác với giao việc nha bạn.
)Trên bảng mô tả công việc của bạn có mục nào ghi kiểu như "thực hiện các công việc trên excel bằng macro" không
Ghi trên bảng mô tả công việc (khi tuyển dụng) khác với giao việc nha bạn.
Những công việc trên bảng mô tả công việc là trách nhiệm của bạn, bạn phải làm những việc đó để hưởng mức lương đó.
Còn khi giao việc phải phù hợp với bảng mô tả công việc, giao những việc ngoài bảng mô tả công việc bạn có thể từ chối (nguyên tắc là vậy
Sếp e rất là tốt anh nhé
Chào Thầy
Dim cn As Object, Str, Path As String
Path = PathFolderQuanLy & TenPX & "\" & TenFileBangQDThangTruoc
Set cn = CreateObject("ADODB.Connection")
Str = "Select * from [BangChamCong$B5:C] where f1 is not null"
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Path & ";Extended Properties=""Excel 12.0;HDR=No"";"
FileBangQD.Sheets("BangLuong").Range("B5").CopyFromRecordset cn.Execute(Str)
cn.Closeà em hiểu rồi anh ạ. Em cảm ơn a
À anh ơi, đoạn này "Extended Properties=""Excel 12.0;HDR=No"";"" nghĩa là gì ạ.à em hiểu rồi anh ạ. Em cảm ơn a
Thuộc tính mở rộng "Excel 12.0" là dùng cho excel 2007 trở lên đúng không ạ. Còn cái "HDR=No" hoặc "HDR=Yes" có gì khác nhau ạ.
Bạn xem thử!
1 Dim cn As Object
Dim truyVan As String
truyVan = " select * from [EXCEL 8.0;Database=" & ThisWorkbook.Path & "\<tenFile>].[A1:K] where [SO]=" & Sheet1.TextBox1.Text
truyVan = Replace(truyVan, "<tenFile>", "1.xls") & " UNION ALL " & Replace(truyVan, "<tenFile>", "2.xls") & " UNION ALL " & Replace(truyVan, "<tenFile>", "3.xls")
Set cn = CreateObject("ADODB.Connection")
cn.Open ("Provider=Microsoft.JET.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0")
.Range("A2:K20").ClearContents
2 .Range("A2").CopyFromRecordset cn.Execute(truyVan)Em hiểu rồi, em cảm ơn ạ
Private Sub CommandButton1_Click()
If TextBox1 = "" Then
TextBox1.BackStyle = 1
TextBox1.BackColor = RGB(255, 128, 128)
MsgBox "KHONG DUOC DE TRONG"
Exit Sub
End If
If TextBox2 = "" Then
TextBox2.BackStyle = 1
TextBox2.BackColor = RGB(255, 128, 128)
MsgBox "KHONG DUOC DE TRONG"
Exit Sub
End If
If TextBox3 = "" Then
TextBox3.BackStyle = 1
TextBox3.BackColor = RGB(255, 128, 128)
MsgBox "KHONG DUOC DE TRONG"
Exit Sub
End If
End Sub
Anh thử như thế này xem sao:
Private Sub CommandButton1_Click()
Dim Tb
For Each Tb In UserForm1.Controls
If UCase(TypeName(Tb)) = "TEXTBOX" Then
If Tb = "" Then
Tb.BackStyle = 1
Tb.BackColor = RGB(255, 128, 128)
MsgBox "KHONG DUOC DE TRONG"
End If
End If
Next Tb
End SubPrivate Sub CheckTextBoxEmpty(txt As MSForms.TextBox)
If Len(Trim$(txt.Text)) = 0 Then
txt.BackStyle = 1
txt.BackColor = RGB(255, 128, 128)
txt.SetFocus
Err.Raise vbObjectError + 1, "", "KHONG DUOC DE TRONG " & txt.Name
End If
End Sub
Private Sub CommandButton1_Click()
On Error GoTo ErrHandler
CheckTextBoxEmpty TextBox1
CheckTextBoxEmpty TextBox2
CheckTextBoxEmpty TextBox3
MsgBox "All textboxes OK :)"
' Your code here
Exit Sub
ErrHandler:
MsgBox Err.Description, vbCritical Or vbOKOnly, "Error"
End SubPrivate Function CheckTextBoxEmptyByTag(frm As MSForms.UserForm) As Boolean
Dim ctl As Control
CheckTextBoxEmptyByTag = False
For Each ctl In frm.Controls
If TypeName(ctl) Like "TextBox" And Len(ctl.Tag) <> 0 Then
If Len(Trim$(ctl.Text)) = 0 Then
ctl.BackStyle = 1
ctl.BackColor = RGB(255, 128, 128)
ctl.SetFocus
MsgBox "KHONG DUOC DE TRONG TEXTBOX " & ctl.Tag, vbCritical Or vbOKOnly, "Error"
CheckTextBoxEmptyByTag = True
Exit Function
End If
End If
Next
End Function
Private Sub CommandButton1_Click()
If CheckTextBoxEmptyByTag(UserForm1) = True Then Exit Sub
MsgBox "All textboxes OK :)"
End SubNếu form của bạn nhiều textbox, có cái yêu cầu không để trống, cái có thể để trống thì bạn có thể dùng đoạn code dưới.
Chịu khó test từng textbox không được để trống thôi.
Đoạn code của bạn PacificPR sẽ bị lỗi là nếu có bao nhiêu textbox rỗng thì Excel sẽ quăng MsgBox bao nhiêu lần.Mã:Private Sub CheckTextBoxEmpty(txt As MSForms.TextBox) If Len(Trim$(txt.Text)) = 0 Then txt.BackStyle = 1 txt.BackColor = RGB(255, 128, 128) txt.SetFocus Err.Raise vbObjectError + 1, "", "KHONG DUOC DE TRONG " & txt.Name End If End Sub Private Sub CommandButton1_Click() On Error GoTo ErrHandler CheckTextBoxEmpty TextBox1 CheckTextBoxEmpty TextBox2 CheckTextBoxEmpty TextBox3 MsgBox "All textboxes OK :)" ' Your code here Exit Sub ErrHandler: MsgBox Err.Description, vbCritical Or vbOKOnly, "Error" End Sub
MsgBox này tôi đã cố tránh trong code của tôi. Lúc đầu dùng function return Boolean thì do Excel VBA không có tính năng kiểm tra tắt điều kiện logic nên bị MsgBox nhiều lần. Vì vậy tôi mới dùng cách raise Err.
Mạo muội code lại code của bạn PacificPR như sau, dùng cách duyệt qua các TextBox, TextBox nào có Tag property khác rỗng thì check nó có empty hay không. Cách dùng Tag property này chúng tôi hay dùng hồi xưa.
Mã:Private Function CheckTextBoxEmptyByTag(frm As MSForms.UserForm) As Boolean Dim ctl As Control CheckTextBoxEmptyByTag = False For Each ctl In frm.Controls If TypeName(ctl) Like "TextBox" And Len(ctl.Tag) <> 0 Then If Len(Trim$(ctl.Text)) = 0 Then ctl.BackStyle = 1 ctl.BackColor = RGB(255, 128, 128) ctl.SetFocus MsgBox "KHONG DUOC DE TRONG TEXTBOX " & ctl.Tag, vbCritical Or vbOKOnly, "Error" CheckTextBoxEmptyByTag = True Exit Function End If End If Next End Function Private Sub CommandButton1_Click() If CheckTextBoxEmptyByTag(UserForm1) = True Then Exit Sub MsgBox "All textboxes OK :)" End Sub
Vãi, bao nhiêu năm rồi mới ngồi gõ lại code, mà là code Vê Bê mới ngán chứ, báo lỗi tùm lum
Có gì bỏ qua, đừng cười em nhé
Chỗ em bôi đỏ phải là cNme chứ a nhỉ
Gợi ý thêm một khả năng mới.
Sắp được like rồi.
Cái đó mình tạo 1 form nhỏ để lấy hướng test và nhờ các a/c giúp đỡ. Còn sau mình áp dụng vào của mình thì đã dùng sự kiện để bỏ cái đỏ choét đó rùi ý, k nó ngứa mắt chết luôn
@PacificPR @AutoReply Cả 2 chị đều đẹp gáiEm đoán nhà họ đặt cái màu đỏ choét đó để kiểm soát. Nhưng có bài #1367 thì không cần cái đó nữa. Chị #1368 chả mắng cho còn rồi( Mà cái Bà đó khó tính mà vẫn đẹp gái thế mới sợ chứ ...
Hôm nay vừa nghe cái vụ khai báo không đúng kiểu dữ liệu, nay lại thấy đây.
Thế thì viết như thế này cho gọn hơn
Sub Rectangle2_Click()
Dim sArr(), I As Long, Max As Long
With Sheet1
sArr = .Range("A1", .Range("A" & Rows.Count).End(3)).Value
Max = 0
For I = 1 To UBound(sArr)
If sArr(I, 1) > Max Then Max = sArr(I, 1)
Next I
.Range("B1") = Max
End With
End SubTôi viết lại như sau
Sub Rectangle2_Click()
Dim Dayso()
Dim Max As Integer
Dim iR As Integer
iR = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
ReDim Dayso(iR)
For i = 1 To iR
Dayso(i) = Sheet1.Range("A" & i).Value
Next i
'Max = 0 'Luu y 1
Max = Dayso(1)
'For j = 1 To UBound(Dayso, 1)
For j = 2 To UBound(Dayso, 1)
If Dayso(j) > Max Then
' Sheet1.Range("B" & j) = Dayso(j) 'Lệnh này thừa
' Max = Sheet1.Range("B" & j).Value
Max = Dayso(j)
' Sheet1.Range("B" & j).ClearContents 'Lệnh này thừa
End If
Next j
Sheet1.Range("B1") = Max
End SubSub Rectangle20_Click()
Dim sArr, vTemp As Variant, dblMax As Double
sArr = Sheet1.Range("A1", Sheet1.Range("A" & Rows.Count).End(3)).Value
If Not IsArray(sArr) Then
dblMax = sArr
'de phong truong hop chi co mot o.
Else
dblMax = sArr(1, 1)
For Each vTemp In sArr
If vTemp > dblMax Then
dblMax = vTemp
End If
Next
End If
Sheet1.Range("B1") = dblMax
End SubUổi, mà làm sao để có cái code màu xanh này thế chị?
Option Explicit
Sub Rectangle2_Click()
Dim vArr() As Variant
Dim vMax As Variant, vTemp As Variant
Dim lR As Long, I As Long
' Truong hop cot A khong co du lieu hay chi cell A1 co du lieu rong, text, number hay linh tinh
vMax = Val([A1])
lR = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
If (lR > 1) Then
' Có dữ liệu từ A2 trở đi
vArr = Sheet1.Range("A1:A" & lR).Value ' If lR = 1 thì lệnh này nó quăng error vô mặt em cái đùng
For I = 2 To UBound(vArr) ' Bo qua cell A1
vTemp = Val(vArr(I, 1)) ' Truong hop cell A[I] la du lieu rong, text, number hay linh tinh, không dùng Val thì bị quăng error cái đùng lần nữa :')
If vTemp > vMax Then
vMax = vTemp
End If
Next I
End If
Sheet1.Range("B1") = vMax
End SubTùy theo quan điểm của mỗi người về dữ liệu thôi anh, hàm max của excel thì coi một ô chứa text các con số không phải là số.
Option Explicit
Sub Button1_Click()
Dim a, b, c, d, i As Integer
Dim data(1 To 80, 1 To 2) As Variant
Dim LastRow As Integer
With ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
c = 1
For a = 2 To 16
For b = 12 To 8 Step -1
data(c, 1) = Sheets("2018").Cells(b, a).Value
c = c + 1
Next b
Next a
c = 1
For a = 2 To 16
For b = 12 To 8 Step -1
data(c, 2) = Sheets("2018").Cells(13, a).Value & Sheets("2018").Cells(b, "A").Value
c = c + 1
Next b
Next a
Sheets("CleanerSheet").Range("E6:F99").Value = Worksheets.Application.Transpose(data)
For d = 3 To LastRow
Sheets("CleanerSheet").Cells(d, "B").Select
For i = 1 To 80
If Sheets("CleanerSheet").Cells(d, "B").Value > data(i, 1) And Sheets("CleanerSheet").Cells(d, "B").Value <= data(i + 1, 1) Then
Sheets("CleanerSheet").Cells(d, "C").Value = data(i + 1, 1)
Sheets("CleanerSheet").Cells(d, "D").Value = data(i + 1, 2)
i = i + 1
End If
Next i
Next d
End SubTềnh hềnh là hơi căng...Định bôi nhưng code không cho bôi nên đành trích dẫn luôn
Sheets("CleanerSheet").Cells(d, "B").SelectSheets("CleanerSheet").Select 'Thêm dòng này'
For d = 3 To LastRowFor i = 1 To 80
If sal > data(1, i) And sal <= data(1, i + 1) ThenDim data(1 To 80, 1 To 2)FileQLSX.Sheets("BANG_TINH").Range("B22:Z" & LastRowNo).SpecialCells(xlCellTypeVisible).Copy
FileBangQD.Sheets("CongLamKH").Range("D3").PasteSpecial xlPasteValuesStr5 = "Select * from [BANG_TINH$B22:Z] where F1 is not null"
FileBangQD.Sheets("ThongSo").Range("D3").CopyFromRecordset cnn.Execute(Str5)Thank sư huynh đã quan tâm. Không phải không nói ra, mà em nói chi tiết trong file đính kèm ạ.
Sư huynh có thể chỉ e rõ hơn đc ko, trình của e kém lắm.
Cảm ơn sư huynh nhiều ạ
