Tạo sub lấy kích thước B và H, khi nhập vào 1 text vd 20X40-30X50 (1 người xem)

[pmhoang]

Tạo sub lấy kích thước B và H, khi nhập vào 1 text vd 20X40-30X50 (X ở đây luôn là chữ hoa)

[GPECODE=vb]Sub lay_kich_thuoc()
Dim B, H, B2, H2 As String
Dim text1, text2, text3, text4, text5, text6 As String


text1 = "20X40" '--Ket qua: B=20,H=40,B2=20,H2=40,
text2 = "20X120" '--Ket qua: B=20,H=120,B2=20,H2=120,
text3 = "160X150" '--Ket qua: B=160,H=150,B2=160,H2=150,


text4 = "20X40-30X50" '--Ket qua: B=20,H=40,B2=30,H2=50,
text5 = "20X100-120X50" '--Ket qua: B=20,H=100,B2=120,H2=50,
text6 = "100X40-30X120" '--Ket qua: B=100,H=40,B2=30,H2=120,


Call s_kichthuoc_BH(text1, B, H, B2, H2) '--tra ve cac gia tri B,H,B2,H2


MsgBox "Text = " & text1 & text2 & text3 & text4 & text5 & text6 & vbCr & _
"B = " & B & vbCr & _
"H = " & H & vbCr & _
"B2 = " & B2 & vbCr & _
"H2 = " & H2


End Sub

Sub s_kichthuoc_BH(ByVal p_text As String, B, H, B2, H2)
'--thay vay ma lam khoi bi kho, nho anh em giup do.

End Sub

[/GPECODE]

Nguyên lý thì cũng đơn gian mà làm hơi bị rối. Nhờ anh em góp ý với.

 

[gtri]

Có lẽ rối là do bạn chưa xác định được :
- Nhập dữ liệu đầu vào thế nào
- Kết quả xuất ra thế nào
--------------
Bạn xem thử cái này có giúp được gì không

Public Function KichThuoc(Nguon As String) As String
Dim Tam, B, B2, H, H2

If Nguon = "" Then
KichThuoc = ""
Else

If InStr(1, Nguon, "-", 1) = 0 Then
Tam = Split(Nguon, "X")
B = "B=" & Tam(0)
B2 = "B2=" & Tam(0)
H = "H=" & Tam(1)
H2 = "H2=" & Tam(1)
KichThuoc = B & "," & H & "; " & B2 & "," & H2
Else
Tam = Split(Nguon, "-")
B = "B=" & Left(Tam(0), InStr(1, Tam(0), "X", 1) - 1)
B2 = "B2=" & Left(Tam(1), InStr(1, Tam(1), "X", 1) - 1)
H = "H=" & Right(Tam(0), Len(Tam(0)) - InStr(1, Tam(0), "X", 1))
H2 = "H2=" & Right(Tam(1), Len(Tam(1)) - InStr(1, Tam(1), "X", 1))
KichThuoc = B & "," & H & "; " & B2 & "," & H2
End If

End If
End Function

 

[VetMini]

Bài này chính ra dễ như trở bàn tay. Chỉ vì bạn chỉ ham tìm tòi những trò vọc vớ vẩn như giấu code, hiện màu, đổi phông này nọ chứ không chịu học code cho nghiêm chỉnh từ căn bản cho nên chỉ cần gặp vấn đề cần tính toán là bí.

Sub s_kichthuoc_BH(ByVal p_text As String, ByRef B As String, ByRef H As String, _
                                        ByRef B2 As String, ByRef H2 As String)
 [COLOR="#008000"] ' hàm tách chuỗi p_text thành 4 phần[/COLOR]
H = "" ' nếu chuỗi không đúng chuẩn thì hàm trả về H là trống
Dim a
[COLOR="#008000"]' chuẩn dạng chuỗi 99X99 --> 99X99-99X99 --> 99X99X99X99. Nếu có dài cũng chả sao[/COLOR]
a = Split(Replace(UCase(p_text & "-" & p_text), "-", "X"), "X")
If UBound(a) < 3 Then Exit Sub
[COLOR="#008000"]' hàm không kiểm soát dữ liệu. Nếu muốn kiểm soát thì thêm IF Not IsNumeric(a(0))...[/COLOR]
B = a(0)
H = a(1)
B2 = a(2)
H2 = a(3)
End Sub

Code test của bạn cũng viết không chỉnh. Lỗi cả đống mà có chạy cũng chỉ test được có 1 dữ liệu.

Sub lay_kich_thuoc()
Dim B As String, H As String, B2 As String, H2 As String [COLOR="#008000"]' khai báo sai bấy nhầy[/COLOR]
Dim text1, text2, text3, text4, text5, text6 As String
Dim txt(1 To 6) As String, i As Integer
 
txt(1) = "20X40" '--Ket qua: B=20,H=40,B2=20,H2=40,
txt(2) = "20X120" '--Ket qua: B=20,H=120,B2=20,H2=120,
txt(3) = "160X150" '--Ket qua: B=160,H=150,B2=160,H2=150,
txt(4) = "20X40-30X50" '--Ket qua: B=20,H=40,B2=30,H2=50,
txt(5) = "20X100-120X50" '--Ket qua: B=20,H=100,B2=120,H2=50,
txt(6) = "100X40-30X120" '--Ket qua: B=100,H=40,B2=30,H2=120,
 
For i = 1 To 6
Call s_kichthuoc_BH(txt(i), B, H, B2, H2) '--tra ve cac gia tri B,H,B2,H2
MsgBox "Text = " & txt(i) & vbCr & _
"B = " & B & vbCr & _
"H = " & H & vbCr & _
"B2 = " & B2 & vbCr & _
"H2 = " & H2
Next i
 
End Sub

 

[pmhoang]

Bài này chính ra dễ như trở bàn tay. Chỉ vì bạn chỉ ham tìm tòi những trò vọc vớ vẩn như giấu code, hiện màu, đổi phông này nọ chứ không chịu học code cho nghiêm chỉnh từ căn bản cho nên chỉ cần gặp vấn đề cần tính toán là bí.

Do trình độ có hạn, mình cũng đã có gắng lắm, trong khi gửi bài mình cũng tự mày mò và làm ra cái code này,
nó chạy cũng được việc, nhưng có điều là mình làm như làm thủ công vậy, nên không ngắn gọn bằng anh VetMini.

[GPECODE=vb]Sub s_lay_kichthuoc_BH(ByVal p_text As String, ByRef B, ByRef H, ByRef B2, ByRef H2)
Dim p_vitri_, p_vitri_x_1, p_vitri_x_2 As Integer
On Error GoTo CotCN

p_vitri_x_1 = WorksheetFunction.Find("X", p_text)
p_vitri_ = WorksheetFunction.Find("-", p_text)

If p_vitri_ > 0 Then
'--tim thay -
p_vitri_x_2 = WorksheetFunction.Find("X", p_text, p_vitri_)
B = Mid(p_text, 1, p_vitri_x_1 - 1)
H = Mid(p_text, p_vitri_x_1 + 1, p_vitri_ - p_vitri_x_1 - 1)
B2 = Mid(p_text, p_vitri_ + 1, p_vitri_x_2 - p_vitri_ - 1)
H2 = Mid(p_text, p_vitri_x_2 + 1, 3)
End If
Exit Sub
CotCN:
'--khong tim thay -
B = Mid(p_text, 1, p_vitri_x_1 - 1)
H = Mid(p_text, p_vitri_x_1 + 1, 3)
B2 = B
H2 = H
End Sub
[/GPECODE]