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

lala_qn · 2/6/18

em chào anh chị !
em có up lại file vd3 (1) , vừa rùi 2 anh excel_lv1.5 và HieuCD đã 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 ạ !

excel_lv1.5 · 2/6/18

lala_qn đã viết:
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 · 2/6/18

excel_lv1.5 đã viết:

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 · 2/6/18

lala_qn đã viết:
dạ có thể dùng hàm dc ko anh, em ko rành dùng code ạ, Cảm ơn anh !

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!!!

lala_qn · 2/6/18

excel_lv1.5 đã viết:
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 · 2/6/18

lala_qn đã viết:
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

lala_qn · 2/6/18

excel_lv1.5 đã viết:

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é !

excel_lv1.5 · 2/6/18

lala_qn đã viết:
dạ anh chỉnh lại dùm em cột C khoảng cách nối với D
anh nhé !

Bạn nhận lại file!!!

lala_qn · 2/6/18

excel_lv1.5 đã viết:
Bạn nhận lại file!!!

dạ ok rùi , em cảm ơn anh nhiều ạ!

lala_qn · 2/6/18

excel_lv1.5 đã viết:
Bạn nhận lại file!!!

anh ơi, giúp thêm dùm em với ạ
em có up lại vd2, em cần kết quả trong 3 sheet cho file đa dạng em dễ chỉnh sữa ạ
em cảm ơn anh!

excel_lv1.5 · 2/6/18

lala_qn đã viết:
anh ơi, giúp thêm dùm em với ạ
em có up lại vd2, em cần kết quả trong 3 sheet cho file đa dạng em dễ chỉnh sữa ạ
em cảm ơn anh!

Bạn gửi file kết quả bạn cần lên đi, nhìn file bạn không biết bạn muốn như thế nào?

lala_qn · 2/6/18

excel_lv1.5 đã viết:
Bạn gửi file kết quả bạn cần lên đi, nhìn file bạn không biết bạn muốn như thế nào?

dạ em mới up lại file rùi anh ạ

excel_lv1.5 · 2/6/18

lala_qn đã viết:
dạ em mới up lại file rùi anh ạ

Tôi làm cho bạn lần này nữa thôi nhe!! Bấm nút "Run" bên sheet1 để chạy cho 3 sheet.

lala_qn · 2/6/18

ở 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 · 2/6/18

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 · 2/6/18

phulien1902 đã viết:
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 · 3/6/18

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 · 5/6/18

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 · 5/6/18

lala_qn đã viết:
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

lala_qn · 5/6/18

HieuCD đã viết:

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 ạ

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

Thành viên tiêu biểu

File đính kèm

Thành viên tích cực

Thành viên tiêu biểu

Thành viên tích cực

File đính kèm

Thành viên tiêu biểu

Thành viên tích cực

File đính kèm

Thành viên tiêu biểu

Thành viên tích cực

File đính kèm

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tích cực

Thành viên tiêu biểu

Thành viên tích cực

File đính kèm

Thành viên tiêu biểu

GPE - My love

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tiêu biểu

Chuyên gia GPE

File đính kèm

Thành viên tiêu biểu

File đính kèm

Facebook

Group