Chuyên mục xử lý, gỡ rối code VBA

Liên hệ QC
Status
Không mở trả lời sau này.

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,930
Đại khái vầy. Bạn thay [A1] thành ô đầu tiên của vùng ghi dữ liệu.
PHP:
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 = KetQua

Anh Hữu Thắng ơi em muốn hoi thêm 1 chút nữa được không ạ
Em muốn thêm 1 vài dòng định nghĩa cho cái textbox1 khi em có nhiều ô giá trị giống nhau
ví dụ em điền a1 vào ô textbox 1 thì vba sẽ tính nó là "112211221122"
a2 vào textbox 1 vba sẽ tính nó là "ssbbccgghh"
a3 vào textbox 1 vba sẽ tính nó là "sgsbbgccggghgh" chẳng hạn
 
Upvote 0
Anh Hữu Thắng ơi em muốn hoi thêm 1 chút nữa được không ạ
Em muốn thêm 1 vài dòng định nghĩa cho cái textbox1 khi em có nhiều ô giá trị giống nhau
ví dụ em điền a1 vào ô textbox 1 thì vba sẽ tính nó là "112211221122"
a2 vào textbox 1 vba sẽ tính nó là "ssbbccgghh"
a3 vào textbox 1 vba sẽ tính nó là "sgsbbgccggghgh" chẳng hạn
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.
PHP:
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 = KetQua
 
Upvote 0
Nhờ các bạn chỉ giúp!
Ban đầu mình có một vùng dữ liệu từ ô B2:F15 và đã đặt tên là MAINDATA (đây là vùng dữ liệu động, vùng này sẽ thay đổi vị trí mỗi khi kết qua tính toán thay đổi, nhưng số lượng của hàng và cột không đổi) Mình muốn gán một biến cho vùng này qua tên đã đặt, chứ không qua địa chỉ hàng/cột như trên. Để cho dù là bất cứ kết quả nào thì vẫn chỉ là vùng MAINDATA mà thôi.
Mình đang chỉ dùng được cách: "Set rng = Range("B2:F15")". nhưng khi dùng "Set rng = Range("MAINDATA")" thì không được. Do vậy, khi kết quả thay đổi thì đoạn code cũng đi tong luôn.
Các bạn chỉ giúp minh cách gán biến 'rng' cho vùng dữ liệu MAINDATA này với.
 
Upvote 0
Nhờ các bạn chỉ giúp!
Ban đầu mình có một vùng dữ liệu từ ô B2:F15 và đã đặt tên là MAINDATA (đây là vùng dữ liệu động, vùng này sẽ thay đổi vị trí mỗi khi kết qua tính toán thay đổi, nhưng số lượng của hàng và cột không đổi) Mình muốn gán một biến cho vùng này qua tên đã đặt, chứ không qua địa chỉ hàng/cột như trên. Để cho dù là bất cứ kết quả nào thì vẫn chỉ là vùng MAINDATA mà thôi.
Mình đang chỉ dùng được cách: "Set rng = Range("B2:F15")". nhưng khi dùng "Set rng = Range("MAINF")" thì không được. Do vậy, khi kết quả thay đổi thì đoạn code cũng đi tong luôn.
Các bạn chỉ giúp minh với.
Vì sao bạn không làm cách này?
PHP:
Set rng = Range("B2:F15")
 
Upvote 0
Nếu scope của name là worksheet thì chỉ khi nào sheet ấy đang active mới sử dụng được.
 
Upvote 0
Vào name manager, xét lại xem scope của nó là cái gì.
Nếu không phải là workbook thì sửa lại. Hình như nó khong cho sửa scope, chỉ có xoá đi và tạo lại cái khác
 
Upvote 0
e có file kết quả , nhưng nó không tự up date được dữ liệu của ngày sau , anh chị nào giúp em sửa lỗi không ạ ?
 
Upvote 0
Chào anh/chị,

Em vừa tìm hiểu VBA nên có nhiều thứ không biết. Cho em hỏi em muốn so sánh giá trị số của 2 textbox thì em dùng hàm gì ạ?

Ví dụ: em có textbox1, và textbox2 em muốn viết hàm

if textbox1 >textbox2 then
.......
em muốn trả textbox1 và textbox2 về dạng số để so sánh.

Cám ơn anh chị.
 
Upvote 0
Các bác giúp em gộp 2 sự kiện này được không ạ, em muốn thêm 1 sự kiện là AutoFit Row với Merge Cells mà không chỉ chạy được 1 cái
Mã:
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
 
Upvote 0
Các bác giúp em gộp 2 sự kiện này được không ạ, em muốn thêm 1 sự kiện là AutoFit Row với Merge Cells mà không chỉ chạy được 1 cái
Mã:
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. :p
 
Upvote 0
mình có tạo một form nhập liệu chọn ô nhập liệu là combobox thì có lựa chọn nào để nếu nhập không đúng giá trị mình đã chọn trước ở rowsource thì chương trình sẽ báo lỗi không cho nhập tiếp không mọi người.
 
Upvote 0
Xin nhờ các bác hướng dẫn với ạ. (Em xin sửa lại cho dễ hiểu hơn)
Em có 1 file excel như trên nhờ các bác giúp em tạo 1 module với.
1. Vba loại bỏ các trường hợp trùng sau đó và bắt đầu ghi vào dòng thứ 3 cột K (như trong ví dụ sẽ là 1A - 1B - 1D - 1E - 2C - 2E vào các dòng liên tiếp của cột K)

2. Phần công thức:
Giá trị của cột A sẽ là những ký tự chẵn gồm 4 ký tự, 6 ký tự hoặc 8 ký tự. Trong quá trình tính toán vba sẽ tách nó ra làm từng giá trị = 2 ký tự một liền nhau liên tiếp

giá trị x1 : tương ứng ô ở cột A sẽ có 4 ký tự
giá trị x2: tương ứng ô ở cột A sẽ có 6 ký tự
giá trị x3: tương ứng ô ở cột A sẽ có 8 ký tự
giá trị x4: tương ứng ô ở cột A sẽ có 6 ký tự
giá trị x5: tương ứng ô ở cột A sẽ có 8 ký tự

Em muốn tính giá trị cột E bằng các điều kiện sau:

---- Nếu giá trị ô ở cột C= giá trị "x1" thì ta so sánh giá trị ô ở cột A ( như định nghĩa cột A tách ra làm 2 giá trị) với cột F (Cố định từ F2 - F10)
+ Nếu cả 2 nằm trong giá trị của cột F thì cho giá trị ô ở cột E = tương ứng ở cột B*2,
+ Phần còn lại thì cho giá trị ô ở cột E = tương ứng ở cột B*1 (tức là có ít nhất 1 giá trị không thuộc F)

----Nếu giá trị ô ở cột C = giá trị "x2" thì ta so sánh giá trị ô ở cột A ( như định nghĩa cột A tách ra làm 3 giá trị) với cột F (Cố định từ F2 - F10)
+ Nếu cả 3 nằm trong giá trị của cột F thì cho giá trị ô ở cột E = tương ứng ở cột B*3
+ Phần còn lại thì cho giá trị ô ở cột E = tương ứng ở cột B*1.( Tức là có ít nhất 1 giá trị không thuộc F).

---- Nếu giá trị ô ở cột C = giá trị "x3" thì ta so sánh giá trị ô ở cột A ( như định nghĩa cột A tách ra làm 4 giá trị) với cột F (Cố định từ F2 - F10)
+ Nếu cả 4 nằm trong giá trị của cột F thì cho giá trị ô ở cột E = tương ứng ở cột B*4
+ Phần còn lại thì cho giá trị ô ở cột E = tương ứng ở cột B*1.( Tức là có ít nhất 1 giá trị không thuộc F).

---- Nếu giá trị ô ở cột C = giá trị "x4" thì ta so sánh giá trị ô ở cột A ( như định nghĩa cột A tách ra làm 3 giá trị) với cột F (Cố định từ F2 - F10)
+ Nếu cả 3 nằm trong giá trị của cột F thì cho giá trị ô ở cột E = tương ứng ở cột B*6
+ Nếu 2 trong 3 giá trị đó nằm trong giá trị của cột F thì cho giá trị ô ở cột E = tương ứng ở cột B*2
+ Còn lại thì cho giá trị ô ở cột E = tương ứng ở cột B*1

---- Nếu giá trị ô ở cột C = giá trị "x5" thì ta so sánh giá trị ô ở cột A ( như định nghĩa cột A tách ra làm 4 giá trị) với cột F (Cố định từ F2 - F10)
+ Nếu cả 4 nằm trong giá trị của cột F thì cho giá trị ô ở cột E = tương ứng ở cột B*9
+ Nếu 3 trong 4 nằm trong giá trị của cột F thì cho giá trị ô ở cột E = tương ứng ở cột B*6
+ Nếu 2 trong 4 giá trị đó nằm trong giá trị của cột F thì cho giá trị ô ở cột E = tương ứng ở cột B*2
+ Còn lại thì cho giá trị ô ở cột E = tương ứng ở cột B*1

Em không biết tóm tắt sao nên viết hơi dài dòng :D mong các anh giúp đỡ ạ
 
Lần chỉnh sửa cuối:
Upvote 0
Em không biết tóm tắt sao nên viết hơi dài dòng :D 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 đề.
 
Upvote 0
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 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 ạ
 
Upvote 0
Status
Không mở trả lời sau này.
Web KT
Back
Top Bottom