Hì hì.Bạn này đang có ý tưởng viết lại hàm của anh Biil. Chỉ có chị "đẹp" mới hỗ trợ được thôi
Mình không rãnh để lấy trứng chọi đá.Bạn này đang có ý tưởng viết lại hàm của anh Biil. Chỉ có chị "đẹp" mới hỗ trợ được thôi
Topic của nó đây nhé, hiền xem giúp tôi xem, tôi đặt hàm đâu có trùng nhỉ
đúng là như thế, rất cảm ơn bạn, đúng thật là hồ đồ quá, sau này đặt hàm sẽ đặt>3 chữ
Function Tlookup(Rng As Range, SP As String, Num As Long)
Dim frng As Range
Set frng = Rng.Resize(, 1).Find(SP, , xlValues, xlWhole, , , True)(, 2)
Tlookup = IIf(Num < 1 Or frng(, 2) + 1 < frng + Num, Space(0), frng + Num - 1)
Set frng = Nothing
End Function
Đại khái vầy. Bạn thay [A1] thành ô đầu tiên của vùng ghi dữ liệu.
Dim i As Long, KetQua As Variant
ReDim KetQua(1 To Len(Textbox1.Value) \ 2, 1 To 3)
For i = 1 To UBound(KetQua, 1)
KetQua(i, 1) = Mid(Textbox1.Value, (i - 1) * 2 + 1, 2)
KetQua(i, 2) = Textbox2.Value
KetQua(i, 3) = Textbox3.Value
Next
[A1].Resize(UBound(KetQua, 1), 3).Value = KetQuaAnh Huu Thang xử lý nhanh thật.
Cái hàm Range là với Sheet2 hiện thời đang mở, nhưng khi có nhiều sheet và active sheet không phải là sheet2 thì thêm cái gì vào trước Range được ạ ?
Em muốn thêm code check tại textbox1, yêu cầu nhập tại hộp textbox1 phải là số lớn hơn 0 thì thêm đoạn code nào vào được ạ ?
Bạn thử vầy thử xem. Tôi làm chay nên cũng không biết có lỗi gì không.
Dim i As Long, KetQua As Variant, sTextbox1 As String
sTextbox1 = Textbox1.Value
Select Case sTextbox1
Case "a1"
sTextbox1 = "112211221122"
Case "a2"
sTextbox1 = "ssbbccgghh"
Case "a3"
sTextbox1 = "sgsbbgccggghgh"
End Select
ReDim KetQua(1 To Len(sTextbox1) \ 2, 1 To 3)
For i = 1 To UBound(KetQua, 1)
KetQua(i, 1) = Mid(sTextbox1, (i - 1) * 2 + 1, 2)
KetQua(i, 2) = Textbox2.Value
KetQua(i, 3) = Textbox3.Value
Next
[A1].Resize(UBound(KetQua, 1), 3).Value = KetQuaMình đã dùng rồi, nhưng khi vùng dữ liệu MAINDATA này thay đổi địa chỉ thì lại không được.
Bạn vui lòng chỉ mình cú pháp đầy đủ với. Để sao cho gán được biến rng cho vùng dữ liệu MAINDATA.
Cám ơn bạn nhiều!! Mình đã làm được.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$C$1" Then Exit Sub
Dim Rng As Range
On Error Resume Next
Set Rng = Sheet3.Range("B3:B" & Sheet3.[C65500].End(xlUp).Row).Find(Range("C1").Value, , , xlWhole)
If Not Rng Is Nothing Then
Range(Range("D1").Value).Value = Sheet13.[D10] & ", ngày " & Left(Sheet3.Range("G" & Rng.Row).Value, 2) & " tháng " & Mid(Sheet3.Range("G" & Rng.Row).Value, 4, 2) & " n" & ChrW(259) & "m " & Right(Sheet3.Range("G" & Rng.Row).Value, 4) 'Ngay NT (chu)
Range(Range("D2").Value).Value = "S" & ChrW(7888) & ": " & Sheet3.Range("A" & Rng.Row).Value & "/TN" & ChrW(272) & "V" 'So TNDV
Range(Range("D3").Value).Value = " " & Sheet3.[D1] & ": " & Sheet3.Range("D" & Rng.Row).Value 'Hang muc
Range(Range("D4").Value).Value = " " & Sheet3.[C1] & ": " & Sheet3.Range("C" & Rng.Row).Value 'Ten doi tuong lay mau
Range(Range("D5").Value).Value = Sheet3.Range("E" & Rng.Row).Value 'Nguon vat tu
End If
Set Rng = Nothing
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range
With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub
Mình đang đoán là bạn căn dòng của biên bản nghiệm thu vật liệu, hoặc biên bản lấy mẫu vật liệu gì đó. Nhưng bạn tung hỏa mù thế này thì có trời mới giúp được. Tốt nhất bạn lập Topic mới đính kèm file và nói yêu cầu vướng mắc thì sẽ nhanh có kết quả thôi.
mong các anh giúp đỡ ạ
Thông thường viết dài (chi tiết) thì sẽ dễ hiểu nhưng bạn viết dài tôi đọc cũng không hiểu. Chắc tại khả năng đọc hiểu của tôi có vấn đề.Em không biết tóm tắt sao nên viết hơi dài dòng
Ý em là muốn tính giá trị của cột E phụ thuộc vào các điều kiện tương ứng ấy ạ. Ví dụ tính giá trị ô E2 thì phụ thuộc vào các giá trị ô A2,B2,C2,D2 và giá trị $F$2:$F$7 như trong phần giải thích ạ
Anh huuthang_bd giúp em với anh ơi
Em xin lỗi anh huuthang_bd, em đã chỉnh sửa lại nội dung hỗ trợ và up lại file nhưng không hiểu sao không được, em up lại file mong anh giúp đỡ em ạ !
Công thức mảng cho ô E2
=(SUM(LARGE(COUNTIF($F$2:$F$10,MID(A2,ROW($A$1:$A$4)*2-1,2)),ROW($A$1:$A$4))*IF(--RIGHT(D2)<4,{0;1;1;1},{0;1;4;3}))+1)*B2Sub Button1_Click()
Dim Arr As Variant
Arr = UniqueAndSort(Range("C2:C" & Cells(&H100000, 3).End(xlUp).Row))
Range("K3").Resize(UBound(Arr, 1)).Value = Arr
End SubPrivate Function UniqueAndSort(ByVal Rng As Variant) As Variant
Dim i As Long, j As Long, Dic As Object, Arr As Variant, ResultArr() As String, Pos As Long
Set Dic = CreateObject("Scripting.Dictionary")
If Rng.Count = 1 Then
ReDim ResultArr(1 To 1, 1 To 1)
ResultArr(1, 1) = Rng.Value
Else
Arr = Rng.Value
For i = 1 To UBound(Arr, 1)
Dic.Item(Arr(i, 1)) = ""
Next
Arr = Dic.Keys
ReDim ResultArr(1 To Dic.Count, 1 To 1)
Dic.RemoveAll
For i = LBound(Arr, 1) To UBound(Arr, 1)
Pos = i
For j = i + 1 To UBound(Arr, 1)
If Arr(j) < Arr(Pos) Then Pos = j
Next
ResultArr(i + 1, 1) = Arr(Pos)
Arr(Pos) = Arr(i)
Next
End If
UniqueAndSort = ResultArr
End FunctionThì tôi làm vậy. Sai chỗ nào? Chú ý đọc kỹ hướng dẫn của tôi, chỗ nào cần nhấn tôi cũng đã nhấn rồi.Anh ơi có lẽ em giải thích anh lại hiểu sai ý em
ví dụ A2 sẽ là AA , BB và so sánh với giá trị cột F
A3 sẽ là BB,CC,DD
A4 sẽ là 1A,B3,D8,K9
từ đó dựa vào các điều kiện trong các ô tương ứng để tính ra giá trị trong các ô E2 , E3 , E4 ....
Có sửa lại công thức một chút.Anh ơi có lẽ em giải thích anh lại hiểu sai ý em
ví dụ A2 sẽ là AA , BB và so sánh với giá trị cột F
A3 sẽ là BB,CC,DD
A4 sẽ là 1A,B3,D8,K9
từ đó dựa vào các điều kiện trong các ô tương ứng để tính ra giá trị trong các ô E2 , E3 , E4 ....
Vậy chắc là lúc nãy nó bị xung đột cái gì rồi . Bạn xem luôn dùm mình cái file Phân tích vật tư ở phía trên luôn cái. Nó bị lỗi gì mà tìm không ra
Cái Code cũ sửa lại như thế này thì chạy được
Public Sub DanhSachVatTu()
Dim R As Range 'Pham vi trong BANG VAT LIEU can phan tich vat tu
Dim DanhSachVT() As LoaiVatTu ' Mang dong chua danh sach vat tu
Dim I As Long ' Chi so Mang dong
Dim K As Range ' Bien nay dung de duyet bang du lieu trong R
'chon vung du lieu can tinh TONG HOP VAT TU
Set R = Application.InputBox("Chon vung du lieu can tong hop vat tu", Type:=8)
I = 0 'chi so dau tien cua Mang vat tu la 0
Dim ii As Long
Dim ok As Boolean
'Doc du lieu tu sheet "Phan tich vat tu"
For Each K In R.Columns(1).Cells 'Chay qua tung o cua cot R
If Trim(K.Value) <> "" Then ' Trim la de cat bo nhung khoang trang trong tung o du lieu
If I = 0 Then ' vat tu dau tien trong danh sach
ReDim Preserve DanhSachVT(I) 'Gan du lieu cho vat tu dau tien
DanhSachVT(I).MaSo = Trim(K.Value)
DanhSachVT(I).Ten = Trim(K.Offset(0, 1).Value)
DanhSachVT(I).DonVi = Trim(K.Offset(0, 2).Value)
DanhSachVT(I).KhoiLuong = K.Offset(0, 3).Value
I = I + 1 ' tang chi so mang len 1
Else ' Neu danh sach vat tu lon hon 1
ok = True
For ii = 0 To I - 1
'vat tu nay da co trong danh sach
If DanhSachVT(ii).MaSo = Trim(K.Value) Then
ok = False
DanhSachVT(ii).KhoiLuong = DanhSachVT(ii).KhoiLuong + K.Offset(0, 3).Value
Exit For
End If
Next ii
'vat tu chua co ten trong danh sach
If ok Then
ReDim Preserve DanhSachVT(I) 'Gan du lieu cho vat tu dau tien
DanhSachVT(I).MaSo = Trim(K.Value)
DanhSachVT(I).Ten = Trim(K.Offset(0, 1).Value)
DanhSachVT(I).DonVi = Trim(K.Offset(0, 2).Value)
DanhSachVT(I).KhoiLuong = K.Offset(0, 3).Value
I = I + 1
End If
End If
End If
Next
'Ghi ket qua ra Excel, trong sheet "Tong hop vat tu"
Dim J As Long
Dim row As Long
row = 3 'Bat dau ghi du lieu tu dong so 1
For J = LBound(DanhSachVT) To UBound(DanhSachVT)
Sheet2.Cells(row + J, 1).Value = J + 1
Sheet2.Cells(row + J, 2).Value = DanhSachVT(J).MaSo
Sheet2.Cells(row + J, 3).Value = DanhSachVT(J).Ten
Sheet2.Cells(row + J, 4).Value = DanhSachVT(J).DonVi
Sheet2.Cells(row + J, 5).Value = DanhSachVT(J).KhoiLuong
Next J
MsgBox "Ket thuc"
End SubEm cảm ơn anh lắm lắm, anh quá là pro luôn
Trường hợp của bạn thì đoán ý bạn khó hơn việc giải quyết vấn đề.Em cảm ơn anh lắm lắm, anh quá là pro luôn
Nói như thế này thì ai cũng hiểu: Lọc duy nhất cột C sau đó sắp xếp lại và ghi kết quả vào cột K, bắt đầu từ K3.
Em còn một mong muốn nữa, mong anh giải thích dùm em cái công thức của anh cho nó chọn vẹn ạ
) sẽ phải if nó bằng luôn giá trị đó là đc hay phải viết 1 công thức mới. Em cảm ơn anh Thắng nhiều !
Giải thích thì tôi... thua. Cái này tôi nhờ bạn tôi làm giùm đóDạ, em dùng từ ngữ còn rối quá
=(SUM(LARGE(COUNTIF($F$2:$F$10,MID(A2,ROW($A$1:$A$4)*2-1,2)),ROW($A$1:$A$4))*IF(--RIGHT(D2)<4,(ROW($A$1:$A$4)=RIGHT(D2)+1)*RIGHT(D2),{0;1;4;3}))
Em chưa hiểu hết logic trong đó, nên mới thắc mắc tại sao lại lấy giá trị MID(A2,ROW($A$1:$A$4)*2-1,2 )hay các số đằng sau nó {0;1;4;3} và
Thay --RIGHT(D2) và RIGHT(D2) thànhnếu thằng D nó ko phải các giá trị x1,x2,x3,x4,x5 mà là bút,vở,sách,bảng thì sẽ thế nào
MATCH(D2,{"Bút","Vở","Sách","Bảng","Thước"})Em cảm ơn anhGiải thích thì tôi... thua. Cái này tôi nhờ bạn tôi làm giùm đó
Thay --RIGHT(D2) và RIGHT(D2) thành
Mã:MATCH(D2,{"Bút","Vở","Sách","Bảng","Thước"})
Sub Mang_sArr()
Dim Dic As Object
Dim sArr(), dArr
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
sArr = .range(.[a6],.[a1000]).End(xlUp)).Resize(,4).value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 4)
End SubDư dấu đóng ngoặc sau [a1000]
Vậy sau dòng này có nghĩa là gì vậy anh?
sArr = .Range(.[C6], .[C65536].End(xlUp)).Resize(, 4).ValuesArr = .Range(.[C6], .[C65536].End(xlUp)).Resize(, 4).selectsArr = .Range(.[C6], .[C65536].End(xlUp)).select.[C65536].End(xlUp) tương đương với ô mà khi chọn ô C65536 rồi nhấn Ctrl và phím mũi tên lên.
Select là phương thức (chọn), không trả về giá trị nên bị lỗi khi gán cho biến sArr.
vậy là khi thực hiện dòng lệnh này sẽ trả về giá trị, cụ thể là giá trị bao nhiêu vậy anh?
sArr = .Range(.[C6], .[C65536].End(xlUp)).Resize(, 4).ValueBạn đang tra khảo tôi đấy à?
Em thực sự không biết mà anh. Ví dụ như File này thì
sArr = .Range(.[C6], .[C65536].End(xlUp)).Resize(, 4).ValueBác cứ học từ từ thôi. Không nóng vội được đâu. Bây giờ Bác sang Topic Các câu hỏi về mảng đọc rồi Bác sẽ hiểu
Mình đọc rồi mà chưa hiểu, Pacific nói dùm chỗ này đi.Bác cứ học từ từ thôi. Không nóng vội được đâu. Bây giờ Bác sang Topic Các câu hỏi về mảng đọc rồi Bác sẽ hiểu
Nếu mới đầu thì qua Topic này học căn bản trước đã
Ngay bài 8 Topic các câu hỏi về mảng Thầy NDu đã nói như thế này rồi
Ban chỉ cần nhớ điều này:
- Range và mảng không giống nhau
- 1 Range sau khi biến đổi thành mảng thì đó luôn là mảng 2 chiều
- Muốn biến thành mảng 1 chiều phải thêm các công đoạn khác, chẳng hạn dùng For... Next hoặc hàm TRANSPOSESub test()
Dim sArr
Set sArr = Range([C6], [C65536].End(xlUp)).Resize(, 4)
sArr.Select
End SubHelp giúp em với ạ.
Help giúp em với ạ
dùng thử code
Sub Locngayxuat()
ActiveSheet.Range("$C$8:$Q$1001").AutoFilter Field:=2, Criteria1:=">=" & Range("I6").Value, Operator:=xlAnd, Criteria2:="<=" & Range("K6").Value
End SubCảm ơn anh nhé.
Bạn thử với cái này xem sao:
Sub DanhsoSheets()
Dim i As Long, ShName As String
On Error Resume Next
For i = 1 To 5
ShName = "CD-L" & i
With Sheets(ShName)
.Select
.Range("O8") = Sheets("CD-L1").Range("O8") + 1
End With
Next i
End SubSub DanhsoSheets1()
Dim i As Long, ShName As String, Str As String
On Error Resume Next
Str = "CD-L"
For Each Sh In Worksheets
If Sh.Name Like Str & "*" Then
With Sh
.Select
.Range("O8") = Replace(Sh.Name, Str, "", 1)
End With
End If
Next Sh
End Sub
Nmax là số lớp đất lớn nhất của bạn.
Với vùng range trong bảng tính thì cấu trúc em hiểu rồi Nhưng đối với số sheets thì e nghĩ mãi chưa ra. a đưa ví dụ luôn với code trên DanhSoSheet () dùm em ạ
(Ôi đối với mình thực thực là lớn đấy) nhưng mà toàn công sức của diễn đàn và đặc biệt là sự nhiệt tình của Bác PacificPr cả thôi. Thực sự cảm ơn các bạn nhiều lắm, mình không phải dân IT nhưng mà cũng đang cố gắng hiểu để có thể hoàn thiện dự án nhỏ của mình sớm nhất.Úi. Viết được cả 1 dự án lớn bây giờ Bác còn hỏi cái này
End(xlDown) = End(4)
End(xlup) = End(3)
End(xlToRight) = End(2)
End(xlToLeft) = End(1)
Sub Dinh_Dang()
Dim ir As Integer
Dim ic As Integer
ir = 6 ' Dòng đầu tiên chứa dữ liệu cần định dạng
ic = Range("C65536").End(xlUp).Row ' Dòng cuối cùng chứa dữ liệu cần định dạng
Range("A" & ir, "L" & ic).Select
Selection.HorizontalAlignment = xlCenter 'canh giữa cho đều theo cột
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous ' Kẻ dòng đứng
Selection.Borders(xlInsideHorizontal).LineStyle = xlDot ' Kẻ dòng ngang
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Kẻ khung trái
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous ' Kẻ khung trên
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Kẻ khung dưới
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous ' Kẻ khung phải
End SubViết đích danh thành "Strings.Chr(10)" xem có khỏi không?
Bạn thử sửa thế này nhé!
Public Sub Xuat()
Dim i As Long
For i = 2 To 16
With ActiveWorkbook
.Sheets(1).Cells(i, 1).Formula = "='Sheet1'!B" & i
End With
Next
End SubSub GPE()
Application.Run ("'addin.xla'!xuat")
End Sub
