Xuống dòng theo 1 điều kiện nhất định (6 người xem)

[menuview2002]

Hiện tại mình đang xử dụng 1 phần mềm và cần đổ dữ liệu cho phần mềm đó sử dụng excel. Nhưng phần mềm đó có những giới hạn nhất định. Ví dụ như nếu mình viết công thức tính:
Quantity = Chieu rong * 1.8
Nhưng do ô viết công thức chỉ chứa đủ số kí tự cho đến hết số 1 thành ra:
Quantity = Chieu rong * 1
.8
.8 sẽ bị đẩy xuống dòng thứ 2 và như vậy thì phần mềm sẽ không hiểu được công thức và báo lỗi.
Mình không biết có cách viết hàm nào để khi xét hết giới hạn 20 kí tự thì khi xuống dòng ở kí tự 21 hệ thống xét các kí tự xung quanh xem có dấu cách hay không?Nếu có thì sẽ xuống dòng ở dấu cách gần nhất.

 

[huuthang_bd]

Hiện tại mình đang xử dụng 1 phần mềm và cần đổ dữ liệu cho phần mềm đó sử dụng excel. Nhưng phần mềm đó có những giới hạn nhất định. Ví dụ như nếu mình viết công thức tính:
Quantity = Chieu rong * 1.8
Nhưng do ô viết công thức chỉ chứa đủ số kí tự cho đến hết số 1 thành ra:
Quantity = Chieu rong * 1
.8
.8 sẽ bị đẩy xuống dòng thứ 2 và như vậy thì phần mềm sẽ không hiểu được công thức và báo lỗi.
Mình không biết có cách viết hàm nào để khi xét hết giới hạn 20 kí tự thì khi xuống dòng ở kí tự 21 hệ thống xét các kí tự xung quanh xem có dấu cách hay không?Nếu có thì sẽ xuống dòng ở dấu cách gần nhất.

Nếu bạn muốn hỏi về phần mềm thì liên hệ bên cung cấp phần mềm.
Nếu bạn muốn hỏi về Excel thì nêu cụ thể, dữ liệu ban đầu, kết quả mong muốn và nguyên tắc chuyển từ dữ liệu ban đầu sang kết quả mong muốn.

 

[hoamattroicoi]

Mình không biết có cách viết hàm nào để khi xét hết giới hạn 20 kí tự thì khi xuống dòng ở kí tự 21 hệ thống xét các kí tự xung quanh xem có dấu cách hay không?Nếu có thì sẽ xuống dòng ở dấu cách gần nhất.

Mình viết thử với 1 chuỗi thì bạn test cái này xem sao nhé, giả sử CHUỖI cần tách của bạn ở ô A1 +++ kết quả hiển thị ở ô B1 và B2.

Sub Checkstring()
Dim Pos As Long
Dim AboveLine As String, Belowline As String, mystr As String, PaString As String
PaString = [A1].Value
mystr = Left(PaString, 21)
Pos = InStrRev(mystr, " ")
AboveLine = Left(mystr, Pos)
Belowline = Right(PaString, Len(PaString) - Len(AboveLine))
    If Pos > 0 Then
        [B1].Value = AboveLine
        [B2].Value = Belowline
    Else
        [B1].Value = Left(mystr, 20)
        [B2].Value = Right(PaString, Len(PaString) - 20)
End If
End Sub

 

[menuview2002]

Mình viết thử với 1 chuỗi thì bạn test cái này xem sao nhé, giả sử CHUỖI cần tách của bạn ở ô A1 +++ kết quả hiển thị ở ô B1 và B2.

Sub Checkstring()
Dim Pos As Long
Dim AboveLine As String, Belowline As String, mystr As String, PaString As String
PaString = [A1].Value
mystr = Left(PaString, 21)
Pos = InStrRev(mystr, " ")
AboveLine = Left(mystr, Pos)
Belowline = Right(PaString, Len(PaString) - Len(AboveLine))
    If Pos > 0 Then
        [B1].Value = AboveLine
        [B2].Value = Belowline
    Else
        [B1].Value = Left(mystr, 20)
        [B2].Value = Right(PaString, Len(PaString) - 20)
End If
End Sub

-Mình test thử qua thì cách chia đã chuẩn. Vậy giờ nếu với 1 chuỗi ở A1 dài khoảng 51 kí tự thì như code trên chỉ có ra B1 là kết quả đúng xuống B2 nó sẽ vẫn hiển thị đủ 31 kí tự còn lại không chia tiếp được .
-Hiện tại bài toán mở rộng ra cho cách chia này theo ví dụ: mình có cột A1 -> An chứa toàn chuỗi có 80 kí tự , giờ muốn chia A1->An sang B1,C1,D1... thay vì nằm trên cùng 1 cột B1,B2 như trên và giới hạn 1 dòng max 20 kí tự thì không biết có khả thi không nhỉ.

 

[befaint]

Hiện tại bài toán mở rộng ra

Mình muốn mở rộng "ra" thì mở rộng ngay từ bài đầu tiên ấy!!!!

 

[Phuocam]

giới hạn 1 dòng max 20 kí tự

Bạn có thể nói rõ hơn không?
Ví dụ:
1. Khoảng trắng ở vị trí 18 và 23, Cắt 18 hay 23?
2. Khoảng trắng ở vị trí 18 và 22, Cắt 18 hay 22?

 

[hoamattroicoi]

-Mình test thử qua thì cách chia đã chuẩn. Vậy giờ nếu với 1 chuỗi ở A1 dài khoảng 51 kí tự thì như code trên chỉ có ra B1 là kết quả đúng xuống B2 nó sẽ vẫn hiển thị đủ 31 kí tự còn lại không chia tiếp được .
-Hiện tại bài toán mở rộng ra cho cách chia này theo ví dụ: mình có cột A1 -> An chứa toàn chuỗi có 80 kí tự , giờ muốn chia A1->An sang B1,C1,D1... thay vì nằm trên cùng 1 cột B1,B2 như trên và giới hạn 1 dòng max 20 kí tự thì không biết có khả thi không nhỉ.

Giờ bạn test thử cái này nhé, thích mở rộng lại mở rộng tiếp =)))))

Sub Checkstring()
Dim Pos As Long, Result
Dim AboveLine As String, Belowline As String, mystr As String, PaString As String
PaString = [A1].Value
Do Until Len(PaString) <= 20

    mystr = Left(PaString, 21)
    Pos = InStrRev(mystr, " ")
    AboveLine = Left(mystr, Pos)
    Belowline = Right(PaString, Len(PaString) - Len(AboveLine))
   
        If Pos > 0 Then
            [XFD1].End(xlToLeft).Offset(, 1).Value = AboveLine
            [XFD1].End(xlToLeft).Offset(, 1).Value = Belowline
        Else
            [XFD1].End(xlToLeft).Offset(, 1).Value = Left(mystr, 20)
            [XFD1].End(xlToLeft).Offset(, 1).Value = Right(PaString, Len(PaString) - 20)
        End If

PaString = [XFD1].End(xlToLeft).Value
If Len(PaString) > 20 Then [XFD1].End(xlToLeft).ClearContents

Loop
End Sub

@ befaint : Thế chúng ta mới có việc để làm chứ, hihihi. Đang tập kiên nhẫn, hihi

 

[befaint]

thích mở rộng lại mở rộng tiếp

Mở quá là "rách" đó. =))))

 

[menuview2002]

Giờ bạn test thử cái này nhé, thích mở rộng lại mở rộng tiếp =)))))

Sub Checkstring()
Dim Pos As Long, Result
Dim AboveLine As String, Belowline As String, mystr As String, PaString As String
PaString = [A1].Value
Do Until Len(PaString) <= 20

    mystr = Left(PaString, 21)
    Pos = InStrRev(mystr, " ")
    AboveLine = Left(mystr, Pos)
    Belowline = Right(PaString, Len(PaString) - Len(AboveLine))
  
        If Pos > 0 Then
            [XFD1].End(xlToLeft).Offset(, 1).Value = AboveLine
            [XFD1].End(xlToLeft).Offset(, 1).Value = Belowline
        Else
            [XFD1].End(xlToLeft).Offset(, 1).Value = Left(mystr, 20)
            [XFD1].End(xlToLeft).Offset(, 1).Value = Right(PaString, Len(PaString) - 20)
        End If

PaString = [XFD1].End(xlToLeft).Value
If Len(PaString) > 20 Then [XFD1].End(xlToLeft).ClearContents

Loop
End Sub

@ befaint : Thế chúng ta mới có việc để làm chứ, hihihi. Đang tập kiên nhẫn, hihi

Cám ơn bác nhé cách này chuẩn luôn rồi. Tiện cho em hỏi thêm : nếu như em muốn gom các dòng vừa chia lúc nãy ra hợp lại 1 dòng bên cạnh nhưng trong dòng này các ô vừa góp xuống dòng trong cùng 1 ô: Ví dụ ô A1 giá trị A, B1 giá trị B, C1 giá trị C hợp thành cột D1 giá trị (A alt+ enter B + alt + enter C). Em có attach files ví dụ cho dễ hiểu

 

[hoamattroicoi]

Cám ơn bác nhé cách này chuẩn luôn rồi. Tiện cho em hỏi thêm : nếu như em muốn gom các dòng vừa chia lúc nãy ra hợp lại 1 dòng bên cạnh nhưng trong dòng này các ô vừa góp xuống dòng trong cùng 1 ô: Ví dụ ô A1 giá trị A, B1 giá trị B, C1 giá trị C hợp thành cột D1 giá trị (A alt+ enter B + alt + enter C). Em có attach files ví dụ cho dễ hiểu

Tách xong lại muốn gom lại, max rảnh luôn =)) Bạn chạy đoạn code dưới nhé.

Sub Checkstring()
Dim Pos As Long, Result
Dim AboveLine As String, Belowline As String, mystr As String, PaString As String
Dim sArr(), JoinStr
PaString = [A1].Value
Do Until Len(PaString) <= 20

    mystr = Left(PaString, 21)
    Pos = InStrRev(mystr, " ")
    AboveLine = Left(mystr, Pos)
    Belowline = Right(PaString, Len(PaString) - Len(AboveLine))
  
        If Pos > 0 Then
            [XFD1].End(xlToLeft).Offset(, 1).Value = AboveLine
            [XFD1].End(xlToLeft).Offset(, 1).Value = Belowline
        Else
            [XFD1].End(xlToLeft).Offset(, 1).Value = Left(mystr, 20)
            [XFD1].End(xlToLeft).Offset(, 1).Value = Right(PaString, Len(PaString) - 20)
        End If

PaString = [XFD1].End(xlToLeft).Value
If Len(PaString) > 20 Then [XFD1].End(xlToLeft).ClearContents
Loop

sArr = Range("B1:" & [XFD1].End(xlToLeft).Address).Value
For i = 1 To UBound(sArr, 2)
If sArr(1, i) <> "" Then
    JoinStr = JoinStr & Chr(10) & sArr(1, i)
End If
Next i
[XFD1].End(xlToLeft).Offset(, 1) = JoinStr
End Sub

 

[menuview2002]

Tách xong lại muốn gom lại, max rảnh luôn =)) Bạn chạy đoạn code dưới nhé.

Sub Checkstring()
Dim Pos As Long, Result
Dim AboveLine As String, Belowline As String, mystr As String, PaString As String
Dim sArr(), JoinStr
PaString = [A1].Value
Do Until Len(PaString) <= 20

    mystr = Left(PaString, 21)
    Pos = InStrRev(mystr, " ")
    AboveLine = Left(mystr, Pos)
    Belowline = Right(PaString, Len(PaString) - Len(AboveLine))
 
        If Pos > 0 Then
            [XFD1].End(xlToLeft).Offset(, 1).Value = AboveLine
            [XFD1].End(xlToLeft).Offset(, 1).Value = Belowline
        Else
            [XFD1].End(xlToLeft).Offset(, 1).Value = Left(mystr, 20)
            [XFD1].End(xlToLeft).Offset(, 1).Value = Right(PaString, Len(PaString) - 20)
        End If

PaString = [XFD1].End(xlToLeft).Value
If Len(PaString) > 20 Then [XFD1].End(xlToLeft).ClearContents
Loop

sArr = Range("B1:" & [XFD1].End(xlToLeft).Address).Value
For i = 1 To UBound(sArr, 2)
If sArr(1, i) <> "" Then
    JoinStr = JoinStr & Chr(10) & sArr(1, i)
End If
Next i
[XFD1].End(xlToLeft).Offset(, 1) = JoinStr
End Sub

Cám ơn bạn nhé. Tại phần mềm bọn mình định đổ dùng file excel nếu như xuống dòng ở 1 từ không hoàn chỉnh nó sẽ báo lỗi vậy nên mình mới cần phải xuống dòng trước khi max kí tự thì mới đúng được .

 

[Phuocam]

Giải trí một chút:

Public Function XuongDong(str As String) As String
Dim s As String
Dim k As Long
Dim n As Long
n = 1
k = 21
Do While k < Len(str)
s = Left(str, k)
If InStrRev(s, " ") > n Then
    n = InStrRev(s, " ")
    Mid(str, n, 1) = ChrW(10)
    k = n + 21
ElseIf InStr(n, str & " ", " ") < Len(str) Then
    n = InStr(str, " ")
    Mid(str, n, 1) = ChrW(10)
    k = n + 21
Else
    Exit Do
End If
Loop
XuongDong = str
End Function

 

[VetMini]

Function ReshapeString(byVal s As String, Optional byVal wdth = 20) As String
' hàm tách 1 string s thành từng đoạn có độ dài wdth
' hàm này giả sử giới hạn từ là khoảng trống (dấu cách), và cũng giả sử mỗi từ chỉ cách nhau 1 dấu cách
' và không có từ nào trong câu dài hơn wdth.
Dim nuLine As String
Dim i As Integer, lineLen As Integer, aStr As Variant
nuLine = ChrW(10)
aStr = Split(Application.Trim(s), " ")
i = LBound(aStr)
ReshapeString = aStr(i)
lineLen = Len(ReshapeString) ' chiều dài dòng hiện tại
For i = i + 1 To UBound(aStr)
  lineLen = lineLen + Len(aStr(i)) + 1 ' chiều dài dòng, nếu cộng thêm từ mới
  If lineLen <= wdth Then
    ReshapeString = ReshapeString & " " & aStr(i)
  Else
    ReshapeString = ReshapeString & nuLine & aStr(i)
    lineLen = Len(aStr(i))
  End If
Next i
End Function