Code chuyển đổi đơn vị chiều dài trong vùng (1 người xem)

nguyenkhoadng · 1/5/15

Nhờ các anh giúp em đoạn code chuyển đổi đơn vị trong 1 vùng
Trong file đính kèm em có tạo 1 form gồm:
txtNguon: Lấy đơn vị ở ô K4
txtDich: Nếu bên txtNguon là mm thì bên txtDich là cm và ngược lại
CheckBox1: (Mặc định là có dấu tick) Nếu bỏ dấu tick thì chỉ thay đổi đơn vị ở ô K4, chứ không chuyển đổi toàn bộ giá trị ở vùng màu vàng. Ngược lại nếu có dấu tick thì vừa thay đổi đơn vị ở ô K4, vừa chuyển đổi toàn bộ giá trị ở vùng màu vàng.

Khi nhấn nút "Chuyển đổi" thì vùng màu vàng trong sheet sẽ chuyển đổi đơn vị: Nếu ta chọn chuyển từ mm sang cm thì tất cả giá trị trong vùng màu vàng sẽ chia cho 10. Còn nếu chuyển từ cm sang mm thì nhân 10.
Đồng thời ô K4 cũng nhận luôn đơn vị hiện hành từ txtDich

Lỗi:
Nếu trong vùng màu vàng có vài vị trí không phải là số mà là chữ (giống ở ô D12, H12, E14) thì sẽ hiện bảng thông báo
"Tìm thấy giá trị không hợp lệ tại vị trí: D12, H12, E14
Bạn nên kiểm tra lại bảng tính trước khi thực hiện chuyển đổi"
đồng thời tô màu đỏ tại các ô đó và thoát lệnh.

---------------------------
Em cảm ơn và Chúc các anh lễ 1-5 vui vẻ!

chuot0106 · 1/5/15

nguyenkhoadng đã viết:
Nhờ các anh giúp em đoạn code chuyển đổi đơn vị trong 1 vùng
Trong file đính kèm em có tạo 1 form gồm:
txtNguon: Lấy đơn vị ở ô K4
txtDich: Nếu bên txtNguon là mm thì bên txtDich là cm và ngược lại
CheckBox1: (Mặc định là có dấu tick) Nếu bỏ dấu tick thì chỉ thay đổi đơn vị ở ô K4, chứ không chuyển đổi toàn bộ giá trị ở vùng màu vàng. Ngược lại nếu có dấu tick thì vừa thay đổi đơn vị ở ô K4, vừa chuyển đổi toàn bộ giá trị ở vùng màu vàng.

Khi nhấn nút "Chuyển đổi" thì vùng màu vàng trong sheet sẽ chuyển đổi đơn vị: Nếu ta chọn chuyển từ mm sang cm thì tất cả giá trị trong vùng màu vàng sẽ chia cho 10. Còn nếu chuyển từ cm sang mm thì nhân 10.
Đồng thời ô K4 cũng nhận luôn đơn vị hiện hành từ txtDich

Lỗi:
Nếu trong vùng màu vàng có vài vị trí không phải là số mà là chữ (giống ở ô D12, H12, E14) thì sẽ hiện bảng thông báo
"Tìm thấy giá trị không hợp lệ tại vị trí: D12, H12, E14
Bạn nên kiểm tra lại bảng tính trước khi thực hiện chuyển đổi"
đồng thời tô màu đỏ tại các ô đó và thoát lệnh.

---------------------------
Em cảm ơn và Chúc các anh lễ 1-5 vui vẻ!

Chào bạn! tôi có tải File về xem và đọc yêu cầu của bạn thì cái này gần như bạn nhờ toàn bộ từ A--A rồi.
Theo tôi bạn nên tự làm phần nào chưa làm được thì mới nhờ thôi. Mà nếu không biết toàn bộ thì nên chia ra thành từng phần nhỏ 1. Đọc thấy 1 đống yêu cầu mà không dám giúp nữa.

nguyenkhoadng · 1/5/15

Cảm ơn bạn chuot0106!
Bạn thấy 1 đống như vậy là do mình trình bày chi tiết để các anh chị trên diễn đàn dễ hình dung, dễ giúp thôi.
Nếu chia nhỏ ra nhiều lúc lại bị các anh nói sao không trình bày luôn từ lúc ban đầu cho dễ làm, rồi code lại sửa đi sửa lại, cũng không tiện bạn ah.

chuot0106 · 1/5/15

nguyenkhoadng đã viết:
Cảm ơn bạn chuot0106!
Bạn thấy 1 đống như vậy là do mình trình bày chi tiết để các anh chị trên diễn đàn dễ hình dung, dễ giúp thôi.
Nếu chia nhỏ ra nhiều lúc lại bị các anh nói sao không trình bày luôn từ lúc ban đầu cho dễ làm, rồi code lại sửa đi sửa lại, cũng không tiện bạn ah.

Tôi có ý kiến thế này:
+ Chỗ chọn đơn vị chuyển đổi chỉ có 2 loại "cm" và "m" nên nhập bằng tay luôn, bạn đồng ý chứ?
+ Còn phần khác tôi sẽ giúp!

nguyenkhoadng · 1/5/15

chuot0106 đã viết:
Tôi có ý kiến thế này:
+ Chỗ chọn đơn vị chuyển đổi chỉ có 2 loại "cm" và "m" nên nhập bằng tay luôn, bạn đồng ý chứ?
+ Còn phần khác tôi sẽ giúp!

Mình cảm ơn bạn trước!

dhn46 · 1/5/15

Viết theo kiểu dài nhất để bạn hình dung và có thể tùy biến

Mã:

Private Sub cmdChuyen_Click()
    Dim Cll As Range
    Dim eR As Long
    Dim TBLoi As String
    eR = Range("C65536").End(3).Row
    If Me.CheckBox1.Value = True Then
        If Me.txtDich = "mm" Then
            'Kiem tra dang du lieu
            For Each Cll In Range("D7:D" & eR)
                If IsNumeric(Cll.Value) = False Then
                    TBLoi = TBLoi & Cll.Address & ", "
                End If
            Next
            For Each Cll In Range("E7:E" & eR)
                If IsNumeric(Cll.Value) = False Then
                    TBLoi = TBLoi & Cll.Address & ", "
                End If
            Next
            For Each Cll In Range("H7:H" & eR)
                If IsNumeric(Cll.Value) = False Then
                    TBLoi = TBLoi & Cll.Address & ", "
                End If
            Next
            'Kiem tra loi
            If TBLoi <> "" Then
                TL = MsgBox("Cac o " & Replace(TBLoi, "$", "") & " la Text" & vbclf & "Ban co muon chuyen doi khong", vbYesNo, "Thong bao loi")
            End If
            'Xac nhan loi
            If TL = vbYes Then
                [K4] = "mm"
                'Chuyen doi
                For Each Cll In Range("D7:D" & eR)
                    If IsNumeric(Cll) Then Cll = Cll * 10
                Next
                For Each Cll In Range("E7:E" & eR)
                    If IsNumeric(Cll) Then Cll = Cll * 10
                Next
                For Each Cll In Range("H7:H" & eR)
                    If IsNumeric(Cll) Then Cll = Cll * 10
                Next
            End If
        Else
            'Kiem tra dang du lieu
            For Each Cll In Range("D7:D" & eR)
                If IsNumeric(Cll.Value) = False Then
                    TBLoi = TBLoi & Cll.Address & ", "
                End If
            Next
            For Each Cll In Range("E7:E" & eR)
                If IsNumeric(Cll.Value) = False Then
                    TBLoi = TBLoi & Cll.Address & ", "
                End If
            Next
            For Each Cll In Range("H7:H" & eR)
                If IsNumeric(Cll.Value) = False Then
                    TBLoi = TBLoi & Cll.Address & ", "
                End If
            Next
            'Kiem tra loi
            If TBLoi <> "" Then
                TL = MsgBox("Cac o " & Replace(TBLoi, "$", "") & " la Text" & vbclf & "Ban co muon chuyen doi khong", vbYesNo, "Thong bao loi")
            End If
            'Xac nhan loi
            If TL = vbYes Then
                [K4] = "cm"
                'Chuyen doi
                For Each Cll In Range("D7:D" & eR)
                    If IsNumeric(Cll) Then Cll = Cll / 10
                Next
                For Each Cll In Range("E7:E" & eR)
                    If IsNumeric(Cll) Then Cll = Cll / 10
                Next
                For Each Cll In Range("H7:H" & eR)
                    If IsNumeric(Cll) Then Cll = Cll / 10
                Next
            End If
        End If
    Else
        [K4] = Me.txtDich
    End If
End Sub
Private Sub UserForm_Initialize()
Private Sub UserForm_Initialize()
    Me.txtNguon = [K4]
    If Me.txtNguon = "cm" Then
        Me.txtDich = "mm"
    Else
        Me.txtDich = "cm"
    End If
    Me.CheckBox1.Value = 1
End Sub

nguyenkhoadng · 1/5/15

Cảm ơn bạn dhn46!
Code trên gặp chút vấn đề khi sử dụng, đó là khi trong bảng tính không có lỗi thì code không tiến hành chuyển đổi.
Với lại bạn có thể thêm giúp phần tô màu đỏ ở các ô lỗi để tiện chỉnh sửa.

diemhuyenanh · 1/5/15

bạn xem file đính kèm và bấm chuyển mỏi tay thì thôi

diemhuyenanh · 2/5/15

quên mất một yêu cầu là kiểm tra dữ lieu số. tôi đã làm lại theo đúng yêu cầu của bạn

diemhuyenanh · 2/5/15

quên mất một yêu cầu là kiểm tra dữ lieu số. tôi đã làm lại theo đúng yêu cầu của bạn

nguyenkhoadng · 2/5/15

Mình cảm ơn sự hỗ trợ nhiệt tình từ các bạn!

Code chuyển đổi đơn vị chiều dài trong vùng (1 người xem)

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

nguyenkhoadng

Thành viên hoạt động

chuot0106

Thành viên gắn bó

nguyenkhoadng

Thành viên hoạt động

chuot0106

Thành viên gắn bó

nguyenkhoadng

Thành viên hoạt động

dhn46

Hướng tới tương lai

nguyenkhoadng

Thành viên hoạt động

diemhuyenanh

Thành viên hoạt động

File đính kèm

diemhuyenanh

Thành viên hoạt động

File đính kèm

diemhuyenanh

Thành viên hoạt động

File đính kèm

nguyenkhoadng

Thành viên hoạt động

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

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