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

lala_qn

Thành viên tiêu biểu
Tham gia ngày
2 Tháng năm 2009
Bài viết
598
Được thích
17
Điểm
710
Nơi ở
qn
em chào anh chị !
em có up lại file vd3 (1) , vừa rùi 2 anh excel_lv1.5HieuCD đã giúp em viết code gần hoàn chỉnh file,
trong file hiện tại emcần kết quả ở sheet4, em có ghi yêu cầu ở sheet4 ạ
nhờ anh chị bổ sung dùm em code ở sheet4 để hoàn thiện file
em cảm ơn anh chị nhiều ạ !
 

File đính kèm

Lần chỉnh sửa cuối:

excel_lv1.5

Thành viên tiêu biểu
Tham gia ngày
20 Tháng mười 2017
Bài viết
618
Được thích
1,051
Điểm
360
em chào anh chị !
em có file vd up kèm, trong file kết quả ở cột D,
em muốn kết quả vẫn giữ nguyên size và màu của dữ liệu
nhờ anh chị giúp dùm em hàm này với ạ.
cảm ơn anh chị nhiều !
Bạn chạy thử code này, hàm excel không làm được đâu bạn.
PHP:
Sub a()
Dim rng As Range, i As Long
Set rng = Range("a2:b" & [a100000].End(xlUp).Row)
For i = 1 To rng.Rows.Count
    rng(i, 1).Offset(, 2) = rng(i, 1) & ChrW(10) & rng(i, 2)
    rng(i, 1).Offset(, 2).Characters(1, Len(rng(i, 1))).Font.Color = rng(i, 1).Font.Color
    rng(i, 1).Offset(, 2).Characters(Len(rng(i, 1)) + 1, Len(rng(i, 2)) + 1).Font.Color = rng(i, 2).Font.Color
Next i
End Sub
 

lala_qn

Thành viên tiêu biểu
Tham gia ngày
2 Tháng năm 2009
Bài viết
598
Được thích
17
Điểm
710
Nơi ở
qn
Bạn chạy thử code này, hàm excel không làm được đâu bạn.
PHP:
Sub a()
Dim rng As Range, i As Long
Set rng = Range("a2:b" & [a100000].End(xlUp).Row)
For i = 1 To rng.Rows.Count
    rng(i, 1).Offset(, 2) = rng(i, 1) & ChrW(10) & rng(i, 2)
    rng(i, 1).Offset(, 2).Characters(1, Len(rng(i, 1))).Font.Color = rng(i, 1).Font.Color
    rng(i, 1).Offset(, 2).Characters(Len(rng(i, 1)) + 1, Len(rng(i, 2)) + 1).Font.Color = rng(i, 2).Font.Color
Next i
End Sub
dạ có thể dùng hàm dc ko anh, em ko rành dùng code ạ, thanks anh !
 

excel_lv1.5

Thành viên tiêu biểu
Tham gia ngày
20 Tháng mười 2017
Bài viết
618
Được thích
1,051
Điểm
360

File đính kèm

lala_qn

Thành viên tiêu biểu
Tham gia ngày
2 Tháng năm 2009
Bài viết
598
Được thích
17
Điểm
710
Nơi ở
qn
Bạn bấm Alt+F11, vào Insert->module, rồi paste cái code trên vào, bấm F5 là được.
Hàm không làm được đâu bạn, bạn nhận file, bấm nút RUN!!!
dạ nếu vậy chắc phải dùng hàm rùi
em thấy màu thì thay đổi dc, nhưng size nó vẫn chưa thay đổi theo dữ liệu dc ạ
nhờ anh viết lại hàm dùm em theo vd2 em mới up lại ạ
cảm ơn anh !
 

excel_lv1.5

Thành viên tiêu biểu
Tham gia ngày
20 Tháng mười 2017
Bài viết
618
Được thích
1,051
Điểm
360
dạ nếu vậy chắc phải dùng hàm rùi
em thấy màu thì thay đổi dc, nhưng size nó vẫn chưa thay đổi theo dữ liệu dc ạ
nhờ anh viết lại hàm dùm em theo vd2 em mới up lại ạ
cảm ơn anh !
Bạn sửa code lại như vầy:
PHP:
Sub Button1_Click()
Application.ScreenUpdating = False
Dim rng As Range, i As Long, j As Long, nlen As Long
Set rng = Range("a2:d" & [a100000].End(xlUp).Row)
[e2].Resize(rng.Rows.Count, 1).ClearContents
For i = 1 To rng.Rows.Count
    For j = 1 To rng.Columns.Count
        rng(i, 1).Offset(, 4) = rng(i, 1).Offset(, 4) & IIf(j = 1, "", ChrW(10)) & rng(i, j)
    Next j
    With rng(i, 1).Offset(, 4)
        nlen = 0
        For j = 1 To rng.Columns.Count
            nlen = nlen + Len(rng(i, j)) + 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
        Next j
    End With
Next i
Application.ScreenUpdating = True
End Sub
 

File đính kèm

lala_qn

Thành viên tiêu biểu
Tham gia ngày
2 Tháng năm 2009
Bài viết
598
Được thích
17
Điểm
710
Nơi ở
qn
Bạn sửa code lại như vầy:
PHP:
Sub Button1_Click()
Application.ScreenUpdating = False
Dim rng As Range, i As Long, j As Long, nlen As Long
Set rng = Range("a2:d" & [a100000].End(xlUp).Row)
[e2].Resize(rng.Rows.Count, 1).ClearContents
For i = 1 To rng.Rows.Count
    For j = 1 To rng.Columns.Count
        rng(i, 1).Offset(, 4) = rng(i, 1).Offset(, 4) & IIf(j = 1, "", ChrW(10)) & rng(i, j)
    Next j
    With rng(i, 1).Offset(, 4)
        nlen = 0
        For j = 1 To rng.Columns.Count
            nlen = nlen + Len(rng(i, j)) + 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
        Next j
    End With
Next i
Application.ScreenUpdating = True
End Sub
dạ anh chỉnh lại dùm em cột C khoảng cách nối với D
anh nhé !
 

lala_qn

Thành viên tiêu biểu
Tham gia ngày
2 Tháng năm 2009
Bài viết
598
Được thích
17
Điểm
710
Nơi ở
qn
ở sheet2 anh bỏ dùm e dấu gạch nối "-" thay vao đó là khoảng cách dùm em với ạ
em cảm ơn anh !
 

phulien1902

GPE - My love
Tham gia ngày
6 Tháng bảy 2013
Bài viết
3,450
Được thích
4,308
Điểm
560
Nơi ở
Hải Phòng
Bạn tìm đến dòng:
Case "Sheet2"
rng(i, 1).Offset(, 4) = rng(i, 1).Offset(, 4) & IIf(j = 1, "", IIf(j = 3, ChrW(10), "-")) & rng(i, j)

Và thay "-" bằng " "
 

lala_qn

Thành viên tiêu biểu
Tham gia ngày
2 Tháng năm 2009
Bài viết
598
Được thích
17
Điểm
710
Nơi ở
qn
Bạn tìm đến dòng:
Case "Sheet2"
rng(i, 1).Offset(, 4) = rng(i, 1).Offset(, 4) & IIf(j = 1, "", IIf(j = 3, ChrW(10), "-")) & rng(i, j)

Và thay "-" bằng " "
ở sheet2 nếu sửa như vậy thì trong code sẽ là: A khoảng cách nối B, xuống dòng C khoảng cách nối D
mà em cần là: A nối B, xuống dòng C khoảng cách nối D
nhờ anh chỉnh chổ này giúp em ạ !
 

lala_qn

Thành viên tiêu biểu
Tham gia ngày
2 Tháng năm 2009
Bài viết
598
Được thích
17
Điểm
710
Nơi ở
qn
excel_lv1.5 anh ơi , em ko biết gì về code mong anh giúp hộ e chổ này với ạ, cảm ơn anh !
 

lala_qn

Thành viên tiêu biểu
Tham gia ngày
2 Tháng năm 2009
Bài viết
598
Được thích
17
Điểm
710
Nơi ở
qn
nhờ anh chị xem và chỉnh dùm em code ở sheet2 với sheet4 giúp em với ạ
cảm ơn anh chị nhiều ạ !
 

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,993
Được thích
13,644
Điểm
1,560
nhờ anh chị xem và chỉnh dùm em code ở sheet2 với sheet4 giúp em với ạ
cảm ơn anh chị nhiều ạ !
Chạy thử code
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)
        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, 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")
  Application.ScreenUpdating = False
  For i = 0 To UBound(shArr)
    Call Strformats(shArr(i))
  Next
  Application.ScreenUpdating = True
End Sub
Mới chỉnh lại code
 

File đính kèm

Lần chỉnh sửa cuối:

lala_qn

Thành viên tiêu biểu
Tham gia ngày
2 Tháng năm 2009
Bài viết
598
Được thích
17
Điểm
710
Nơi ở
qn
Chạy thử code
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)
        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, 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")
  Application.ScreenUpdating = False
  For i = 0 To UBound(shArr)
    Call Strformats(shArr(i))
  Next
  Application.ScreenUpdating = True
End Sub
Mới chỉnh lại code
em pase code vào ko biết sai gì mà code ko chạy
anh xem giúp em với ạ
 

File đính kèm

Top Bottom