Giúp em dùng hàm nhưng thay đổi dữ liệu ạ (3 người xem)

  • Thread starter Thread starter lala_qn
  • Ngày gửi Ngày gửi
Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
dạ sheet2 ok rùi a
nhờ anh thêm code ở sheet4 với ạ
sheet4 em cần kết quả ở cột C: thay đổi dc, font chữ, màu chữ, size chữ, kiểu chữ
và: A nối với C
cảm ơn anh!
 
lala_qn đã viết:
trong file vd3 em up lên, anh @excel_lv1.5 có viết giúp em hoàn chỉnh code ở sheet1 và sheet3
còn sheet2 và sheet4chưa đc hoàn chỉnh lắm, em có ghi nội dung cần ở trong mỗi sheet ạ
cảm ơn anh !
Nhấp chuột vào đây để mở rộng...
Sheet4 không có gì để xử lý
Mình dựa vào code của @excel_lv1.5 để viết lại theo cách của mình, cần gì cứ nói yêu cầu
 
HieuCD đã viết:
Sheet4 không có gì để xử lý
Mình dựa vào code của @excel_lv1.5 để viết lại theo cách của mình, cần gì cứ nói yêu cầu
Nhấp chuột vào đây để mở rộng...
dạ anh dựa vào code anh @excel_lv1.5 viết thêm code ở sheet4 nội dung như sau ạ
sheet4 em cần kết quả ở cột C: thay đổi dc, font chữ, màu chữ, size chữ, kiểu chữ
và: A nối với B
cảm ơn anh!
 
lala_qn đã viết:
trong bài em có up lại file thành vd3 (1), nhờ anh xem bài và viết thêm hộ em code ở sheet4 với ạ
em cảm ơn anh!
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub Strformats(ByVal shName As String)
  Dim Rng As Range, tStr As String
  Dim i As Long, j As Long, sCol As Long, nlen As Long
  With Sheets(shName)
    sCol = .Range("A1").End(xlToRight).Column
    Set Rng = .Range("A2:A" & .Range("A65500").End(xlUp).Row)
    For i = 1 To Rng.Rows.Count
      tStr = Rng(i, 1).Value
      For j = 2 To sCol - 1
        Select Case shName
          Case "Sheet1"
            tStr = tStr & IIf(j = 4, " ", ChrW(10)) & Rng(i, j)
          Case "Sheet2"
            tStr = tStr & IIf(j = 2, "", IIf(j = 3, ChrW(10), " ")) & Rng(i, j)
          Case "Sheet3"
            tStr = tStr & IIf(j = 2, ChrW(10), " ") & Rng(i, j)
          Case Else
            tStr = tStr & Rng(i, j)
        End Select
      Next j
     
      With Rng(i, sCol)
        .Value = tStr
        nlen = 0
        For j = 1 To sCol - 1
          nlen = nlen + Len(Rng(i, j)) + IIf((shName = "Sheet2" Or shName = "Sheet4") And j = 2, 0, 1)
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Color = Rng(i, j).Font.Color
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Size = Rng(i, j).Font.Size
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Bold = Rng(i, j).Font.Bold
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Italic = Rng(i, j).Font.Italic
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Name = Rng(i, j).Font.Name
        Next j
      End With
    Next i
  End With
End Sub
Sub Button2_Click()
  Dim i As Long, shArr()
  shArr = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
  Application.ScreenUpdating = False
  For i = 0 To UBound(shArr)
    Call Strformats(shArr(i))
  Next
  Application.ScreenUpdating = True
End Sub
 
HieuCD đã viết:
Mã: 
Sub Strformats(ByVal shName As String)
  Dim Rng As Range, tStr As String
  Dim i As Long, j As Long, sCol As Long, nlen As Long
  With Sheets(shName)
    sCol = .Range("A1").End(xlToRight).Column
    Set Rng = .Range("A2:A" & .Range("A65500").End(xlUp).Row)
    For i = 1 To Rng.Rows.Count
      tStr = Rng(i, 1).Value
      For j = 2 To sCol - 1
        Select Case shName
          Case "Sheet1"
            tStr = tStr & IIf(j = 4, " ", ChrW(10)) & Rng(i, j)
          Case "Sheet2"
            tStr = tStr & IIf(j = 2, "", IIf(j = 3, ChrW(10), " ")) & Rng(i, j)
          Case "Sheet3"
            tStr = tStr & IIf(j = 2, ChrW(10), " ") & Rng(i, j)
          Case Else
            tStr = tStr & Rng(i, j)
        End Select
      Next j
   
      With Rng(i, sCol)
        .Value = tStr
        nlen = 0
        For j = 1 To sCol - 1
          nlen = nlen + Len(Rng(i, j)) + IIf((shName = "Sheet2" Or shName = "Sheet4") And j = 2, 0, 1)
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Color = Rng(i, j).Font.Color
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Size = Rng(i, j).Font.Size
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Bold = Rng(i, j).Font.Bold
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Italic = Rng(i, j).Font.Italic
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Name = Rng(i, j).Font.Name
        Next j
      End With
    Next i
  End With
End Sub
Sub Button2_Click()
  Dim i As Long, shArr()
  shArr = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
  Application.ScreenUpdating = False
  For i = 0 To UBound(shArr)
    Call Strformats(shArr(i))
  Next
  Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
em chạy thì thấy ra kết quả ok hết rùi anh
em thấy còn lỗi chổ này nữa anh
vd sheet1 nhập dữ liệu xong bấm Run để chạy ra dc kết quả, sau đó em xóa dữ liệu đi bấm Run thì nó vẫn hiển thị kết quả cũ anh
em thấy 4 sheet đều bị như vậy anh
 
Lần chỉnh sửa cuối:
lala_qn đã viết:
em chạy thì thấy ra kết quả ok hết rùi anh
em thấy còn lỗi chổ này nữa anh
vd sheet1 nhập dữ liệu xong bấm Run để chạy ra dc kết quả, sau đó em xóa dữ liệu đi bấm Run thì nó vẫn hiển thị kết quả cũ anh
em thấy 4 sheet đều bị như vậy anh
Nhấp chuột vào đây để mở rộng...
Thêm 4 dòng lệnh
i = .Cells(65500, sCol).End(xlUp).Row
If i > 1 Then .Range("E2:E" & i).ClearContents
i = .Range("A65500").End(xlUp).Row
If i < 2 Then Exit Sub
Mã: 
Sub Strformats(ByVal shName As String)
  Dim Rng As Range, tStr As String
  Dim i As Long, j As Long, sCol As Long, nlen As Long
  With Sheets(shName)
    sCol = .Range("A1").End(xlToRight).Column
    i = .Cells(65500, sCol).End(xlUp).Row
    If i > 1 Then .Range("E2:E" & i).ClearContents
    i = .Range("A65500").End(xlUp).Row
    If i < 2 Then Exit Sub
    Set Rng = .Range("A2:A" & .Range("A65500").End(xlUp).Row)
    For i = 1 To Rng.Rows.Count
      tStr = Rng(i, 1).Value
      For j = 2 To sCol - 1
        Select Case shName
          Case "Sheet1"
            tStr = tStr & IIf(j = 4, " ", ChrW(10)) & Rng(i, j)
          Case "Sheet2"
            tStr = tStr & IIf(j = 2, "", IIf(j = 3, ChrW(10), " ")) & Rng(i, j)
          Case "Sheet3"
            tStr = tStr & IIf(j = 2, ChrW(10), " ") & Rng(i, j)
          Case Else
            tStr = tStr & Rng(i, j)
        End Select
      Next j
     
      With Rng(i, sCol)
        .Value = tStr
        nlen = 0
        For j = 1 To sCol - 1
          nlen = nlen + Len(Rng(i, j)) + IIf((shName = "Sheet2" Or shName = "Sheet4") And j = 2, 0, 1)
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Color = Rng(i, j).Font.Color
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Size = Rng(i, j).Font.Size
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Bold = Rng(i, j).Font.Bold
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Italic = Rng(i, j).Font.Italic
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Name = Rng(i, j).Font.Name
        Next j
      End With
    Next i
  End With
End Sub
 
HieuCD đã viết:
Thêm 4 dòng lệnh
i = .Cells(65500, sCol).End(xlUp).Row
If i > 1 Then .Range("E2:E" & i).ClearContents
i = .Range("A65500").End(xlUp).Row
If i < 2 Then Exit Sub
Mã: 
Sub Strformats(ByVal shName As String)
  Dim Rng As Range, tStr As String
  Dim i As Long, j As Long, sCol As Long, nlen As Long
  With Sheets(shName)
    sCol = .Range("A1").End(xlToRight).Column
    i = .Cells(65500, sCol).End(xlUp).Row
    If i > 1 Then .Range("E2:E" & i).ClearContents
    i = .Range("A65500").End(xlUp).Row
    If i < 2 Then Exit Sub
    Set Rng = .Range("A2:A" & .Range("A65500").End(xlUp).Row)
    For i = 1 To Rng.Rows.Count
      tStr = Rng(i, 1).Value
      For j = 2 To sCol - 1
        Select Case shName
          Case "Sheet1"
            tStr = tStr & IIf(j = 4, " ", ChrW(10)) & Rng(i, j)
          Case "Sheet2"
            tStr = tStr & IIf(j = 2, "", IIf(j = 3, ChrW(10), " ")) & Rng(i, j)
          Case "Sheet3"
            tStr = tStr & IIf(j = 2, ChrW(10), " ") & Rng(i, j)
          Case Else
            tStr = tStr & Rng(i, j)
        End Select
      Next j
    
      With Rng(i, sCol)
        .Value = tStr
        nlen = 0
        For j = 1 To sCol - 1
          nlen = nlen + Len(Rng(i, j)) + IIf((shName = "Sheet2" Or shName = "Sheet4") And j = 2, 0, 1)
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Color = Rng(i, j).Font.Color
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Size = Rng(i, j).Font.Size
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Bold = Rng(i, j).Font.Bold
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Italic = Rng(i, j).Font.Italic
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Name = Rng(i, j).Font.Name
        Next j
      End With
    Next i
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
bị lỗi ko chạy dc anh ạ .
 
Anh để em. :p:p
----------------------
lala_qn đã viết:
bị lỗi ko chạy dc anh ạ .
Nhấp chuột vào đây để mở rộng...
Mình bị lỗi lầm làm sao? Chụp cái hình lỗi, chép nội dung lỗi, lỗi tại dòng nào? Đã làm gì mà kêu lỗi?

Mình viết thì sao cho có đầu có cuối, viết cho rõ ràng, không viết tắt, viết cho đúng chính tả nha.!!!
 
anh ơi ! giúp dùm em thêm 1 sheet5 nữa với ạ,
cũng nội dung đó, A nối với B nối với C
em cảm ơn anh ạ !
 

File đính kèm

lala_qn đã viết:
dạ em mới sữa bài up lại file vd3 (2).xlsb có thêm sheet5 vào rùi anh
nhờ anh xem giúp e

dạ file em up kèm ở đây anh nhé
cảm ơn anh nhiều ạ !
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub Strformats(ByVal shName As String)
  Dim Rng As Range, tStr As String
  Dim i As Long, j As Long, sCol As Long, nlen As Long
  With Sheets(shName)
    sCol = .Range("A1").End(xlToRight).Column
    i = .Range("A65500").End(xlUp).Row
    If i < 2 Then Exit Sub
    Set Rng = .Range("A2:A" & .Range("A65500").End(xlUp).Row)
    For i = 1 To Rng.Rows.Count
      tStr = Rng(i, 1).Value
      For j = 2 To sCol - 1
        Select Case shName
          Case "Sheet1"
            tStr = tStr & IIf(j = 4, " ", ChrW(10)) & Rng(i, j)
          Case "Sheet2"
            tStr = tStr & IIf(j = 2, "", IIf(j = 3, ChrW(10), " ")) & Rng(i, j)
          Case "Sheet3"
            tStr = tStr & IIf(j = 2, ChrW(10), " ") & Rng(i, j)
          Case Else
            tStr = tStr & Rng(i, j)
        End Select
      Next j
    
      With Rng(i, sCol)
        .Value = tStr
        nlen = 0
        For j = 1 To sCol - 1
          nlen = nlen + Len(Rng(i, j)) + IIf((shName = "Sheet2" And j = 2) Or ((shName = "Sheet4" Or shName = "Sheet5") And j > 1), 0, 1)
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Color = Rng(i, j).Font.Color
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Size = Rng(i, j).Font.Size
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Bold = Rng(i, j).Font.Bold
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Italic = Rng(i, j).Font.Italic
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Name = Rng(i, j).Font.Name
        Next j
      End With
    Next i
  End With
End Sub
Sub Button2_Click()
  Dim i As Long, shArr()
  shArr = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
  Application.ScreenUpdating = False
  For i = 0 To UBound(shArr)
    Call Strformats(shArr(i))
  Next
  Application.ScreenUpdating = True
End Sub
 
HieuCD đã viết:
Mã: 
Sub Strformats(ByVal shName As String)
  Dim Rng As Range, tStr As String
  Dim i As Long, j As Long, sCol As Long, nlen As Long
  With Sheets(shName)
    sCol = .Range("A1").End(xlToRight).Column
    i = .Range("A65500").End(xlUp).Row
    If i < 2 Then Exit Sub
    Set Rng = .Range("A2:A" & .Range("A65500").End(xlUp).Row)
    For i = 1 To Rng.Rows.Count
      tStr = Rng(i, 1).Value
      For j = 2 To sCol - 1
        Select Case shName
          Case "Sheet1"
            tStr = tStr & IIf(j = 4, " ", ChrW(10)) & Rng(i, j)
          Case "Sheet2"
            tStr = tStr & IIf(j = 2, "", IIf(j = 3, ChrW(10), " ")) & Rng(i, j)
          Case "Sheet3"
            tStr = tStr & IIf(j = 2, ChrW(10), " ") & Rng(i, j)
          Case Else
            tStr = tStr & Rng(i, j)
        End Select
      Next j
   
      With Rng(i, sCol)
        .Value = tStr
        nlen = 0
        For j = 1 To sCol - 1
          nlen = nlen + Len(Rng(i, j)) + IIf((shName = "Sheet2" And j = 2) Or ((shName = "Sheet4" Or shName = "Sheet5") And j > 1), 0, 1)
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Color = Rng(i, j).Font.Color
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Size = Rng(i, j).Font.Size
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Bold = Rng(i, j).Font.Bold
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Italic = Rng(i, j).Font.Italic
          .Characters(nlen - Len(Rng(i, j)), nlen).Font.Name = Rng(i, j).Font.Name
        Next j
      End With
    Next i
  End With
End Sub
Sub Button2_Click()
  Dim i As Long, shArr()
  shArr = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
  Application.ScreenUpdating = False
  For i = 0 To UBound(shArr)
    Call Strformats(shArr(i))
  Next
  Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
em chạy thử thì thấy là A nối B, kết quả ở C
trong file vd4 em cần: A nối B nối C, kết quả ở C ạ
anh sửa code lại dùm em với ạ
cảm ơn anh nhiều !
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

D
Nhờ trợ giúp xác định thứ tự của các từ và cụm từ trong 1 chuỗi văn bản. (4 người xem)
Trả lời
5
Đọc
53
huhumalu
H
GPE-Trợ Lý
Đăng ký tham dự hội thảo tại Hà Nội: Power Query - Công cụ quản lý dữ liệu (1 người xem)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
14
Đọc
2K
GPE-Trợ Lý
GPE-Trợ Lý
1
Vướng mắc về hàm lấy tên đăng nhập máy tính ạ (2 người xem)
Trả lời
17
Đọc
472
VetMini
V
GPE-Trợ Lý
[GPE] HỘI THẢO POWER QUERY – CÔNG CỤ QUẢN LÝ DỮ LIỆU HCM (7 người xem)
Trả lời
0
Đọc
69
GPE-Trợ Lý
GPE-Trợ Lý
G
Xin Code xóa Module. (2 người xem)
Trả lời
10
Đọc
367
GCQ
G
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
16 17 18
Trả lời
348
Đọc
31K
ongke0711
ongke0711
D
  • Đã giải quyết
Quản lý email outlook qua VBA cần giúp đỡ (1 người xem)
2
Trả lời
23
Đọc
641
nguyendang95
N
G
Tách công thức ra khỏi chuỗi và tính kết quả?
2
Trả lời
26
Đọc
2K
thuytrangbp28
T
thlpro
Cách lập Công thức tính số ngày nghỉ AL, ưu tiên tính 2024 trước rồi mới tính 2025 (1 người xem)
Trả lời
8
Đọc
156
bebo021999
B
N
Hàm tăng số đếm theo điều kiện
Trả lời
4
Đọc
78
bebo021999
B
M
Xin giúp đỡ làm công thức điều kiện
    • Yêu thích
Trả lời
3
Đọc
163
tayGa
T
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính (1 người xem)
    • Thích
Trả lời
2
Đọc
231
nguyendang95
N
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table
Trả lời
5
Đọc
188
DeTong
D
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện. (2 người xem)
Trả lời
17
Đọc
291
tle2003
T
Trungvt3
Công thức trả về định dạng không như mong muốn và viết phân số trong 1 ô. (1 người xem)
Trả lời
5
Đọc
124
VetMini
V
N
Khắc phục lỗi "The picture is too large and will be truncated"
Trả lời
10
Đọc
5K
tle2003
T
C
  • Question Question
Xin hỏi Cách viết chú thích trong vba hiển thị tiếng việt (1 người xem)
Trả lời
4
Đọc
198
ongke0711
ongke0711
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước.
    • Thích
2
Trả lời
28
Đọc
7K
Hoàng Tuấn 868
H
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup (1 người xem)
Trả lời
3
Đọc
180
tle2003
T
S
Mở 2 cửa sổ riêng biệt (1 người xem)
2
Trả lời
30
Đọc
23K
sakuraluu
S
Xem thêm…

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

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom