Begrenzen Zeichen von Zellen auf bestimmte Bytes in Worksheet_Change für alle Sprachen

Question

Ich kenne den Code, der einen Zellwert auf bestimmte Längen wie folgt einschränken kann, aber wie kann ich es auf bestimmte Bytes zum Beispiel 240 sagen, wie und es innerhalb des Limits abschneiden? Außerdem wäre der Zeichensatz "shift-jis", d. H. Japanisch + Englisch.

If Not Intersect(Target, Range("A2:B200")) Is Nothing Then 
    For Each cell In Intersect(Target, Columns("A:B")) 
     If (cell.Value) > 20 Then 
      cell.Value = VBA.Left(cell.Value, 20) 
      cell.Select 
      MsgBox "Character limit for the cell is 20." & vbNewLine & "Truncated to 20 characters." 
     End If 
    Next cell 
End If 

Hilfe ist willkommen!

Answer 1

Sie können ADODB.Stream ActiveX verwenden, um eine Zeichenfolge begrenzter Länge von Bytes zu erhalten, die in bestimmten Zeichensatz dargestellt wird. Da Sie keinen Zeichensatz angegeben haben, wählte ich UTF-8 als Beispiel.Ich Code geändert und hinzugefügt LeftUTF8() Funktion, die in Arbeitsblatt-Modul platziert unten Code:

Private Sub Worksheet_Change(ByVal Target As Range) 

    Application.EnableEvents = False 
    If Not Intersect(Target, Range("A2:B200")) Is Nothing Then 
     For Each cell In Intersect(Target, Columns("A:B")) 
      cell.Value = LeftUTF8(cell.Value, 240) 
     Next cell 
    End If 
    Application.EnableEvents = True 

End Sub 

Private Function LeftUTF8(strCont As String, lngLenght As Long) As String 

    Dim i As Long 
    Dim arrCont() As Byte 
    ' add reference to Microsoft ActiveX Data Objects Library (2.5 or later) 
    Static objStream As New ADODB.Stream 

    i = lngLenght 
    With objStream 
     .Type = adTypeText 
     .Open 
     .Charset = "utf-8" 
     .WriteText strCont ' convert string to UTF-8 with BOM 
     .Position = 0 
     .Type = adTypeBinary 
     If .Size > i + 3 Then ' size in bytes greater then limit + 3 bytes UTF-8 BOM 
      For i = i To 1 Step -1 ' if last multibyte char is split then reduce output 
       .Position = i + 3 ' next byte after the last + BOM 
       If AscB(.Read(1)) And 192 <> 128 Then Exit For ' next byte is first byte of next char 
      Next 
     End If 
     .Position = 0 
     arrCont = .Read(i + 3) ' read bytes with BOM corresponding the limit 
     .Close ' clear stream 
     .Open 
     .Type = adTypeBinary 
     .Write arrCont ' write bytes 
     .Position = 0 
     .Type = adTypeText 
     LeftUTF8 = .ReadText ' read string 
     .Close 
    End With 

End Function 

UPDATE

Hier den Code wird eine Reihe von 240 Byte in dargestellt zu bekommen shift-jis charset:

Private Sub Worksheet_Change(ByVal Target As Range) 

    Application.EnableEvents = False 
    If Not Intersect(Target, Range("A2:B200")) Is Nothing Then 
     For Each cell In Intersect(Target, Columns("A:B")) 
      cell.Value = LeftShiftJis(cell.Value, 240) 
     Next cell 
    End If 
    Application.EnableEvents = True 

End Sub 

Private Function LeftShiftJis(strCont As String, lngLenght As Long) As String 

    Dim i As Long 
    Dim arrCont() As Byte 
    ' add reference to Microsoft ActiveX Data Objects Library (2.5 or later) 
    Static objStream As New ADODB.Stream 

    i = lngLenght 
    With CreateObject("ADODB.Stream") 
     .Type = adTypeText 
     .Open 
     .Charset = "shift-jis" 
     .WriteText strCont ' convert string to shift-jis binary representation 
     .Position = 0 
     .Type = adTypeBinary 
     arrCont = .Read(i) ' read limited number of bytes 
     .Close ' clear stream 
     .Open 
     .Type = adTypeBinary 
     .Write arrCont ' write all content, if second byte of last two-byte char is cut off, then zero will be added instead of the missing byte 
     .Position = 0 
     .Type = adTypeText 
     LeftShiftJis = .ReadText ' if last char is two-byte and has second byte cut off, then it is trimmed 
     .Close 
    End With 

End Function 

Answer 2

Wenn ich die Frage richtig verstehe, müssen Sie letztendlich feststellen, ob ein Zeichen in den ANSI-Zeichenbereich fällt (kann durch ein Byte dargestellt werden - 0 bis 255). Excel macht das nicht so einfach wie in den Kommentaren erwähnt. Weder macht VBA, das darstellt, alle Strings intern als UTF-16. Dies wird durch das Problem erschwert, dass sich das Verhalten der VBA Len und LenB nach VB4 geändert hat. Vor dieser Änderung hätten sie unterschiedliche Ergebnisse für die Unicode- oder ANSI-Eingabe zurückgegeben. Nun werden beide das gleiche Ergebnis zurückgeben, da LenB die In-Memory-Länge der Zeichenfolge zurückgibt, die immer 2 Bytes pro Zeichen ist. Was den ANSI-Bereich unterscheidet, ist, dass das 2. Byte immer Null ist.

Die StrConv Funktion bietet eine Möglichkeit zu überprüfen, ob eine Zeichenfolge Nicht-ANSI-Zeichen enthält - Sie können in ein Byte Array konvertieren und überprüfen, ob eines der hohen Bytes festgelegt sind. Zum Beispiel wird die Zeichenfolge „ABCD“ in VBA Speicher gespeichert, wie:

65 0 66 0 67 0 68 0 

Sie eine Marotte von „Unicode-Konvertierung“ VBA verwenden können diese wieder auf 2 Bytes zu erweitern mit StrConv("ABCD", vbUnicode), die dazu führt:

65 0 0 0 66 0 0 0 67 0 0 0 68 0 0 0 

zum Vergleich, wenn Sie die Zeichenfolge „ΑΒΓΔ“ von irgendwo abgeholt (die Sie haben würden, weil es keine Möglichkeit gibt es in der IDE zu geben), könnte es in dieser Folge in Abhängigkeit von der Codierung:

Wenn

Private Function IsANSI(test As String) As Boolean 
    Dim bytes() As Byte, i As Long 
    bytes = StrConv(test, vbUnicode) 
    For i = 1 To UBound(bytes) Step 2 
     If bytes(i) <> 0 Then 
      IsANSI = False 
      Exit Function 
     End If 
    Next i 
    IsANSI = True 
End Function 

: - 83

Also, wenn Sie einen Byte-Array haben, alles, was Sie tun müssen, ist jeden zweiten Byte, wenn Sie nicht-Null-Wert finden, kann es nicht zu ANSI verengt werden alles, was Sie über Pflege ist UTF-16 v ANSI, können Sie die „Byte Länge“ leicht greifen, nachdem Sie auf 8 Bits bestimmen kann verengt werden:

auf der Codierung

Private Function ByteLength(test As String) As Long 
    If IsANSI(test) Then 
     ByteLength = Len(test) 
    Else 
     ByteLength = LenB(test) 
    End If 
End Function 

Beachten Sie, dass Byte Länge immer abhängt. Wenn Sie die Länge der Zeichenfolge in einer bestimmten Codierung benötigen, VBA wird Ihnen nicht viel nativ helfen, es sei denn, es ist eine Codierung fester Breite (dh UTF-32, die VBA wahrscheinlich bereits geschlachtet), müssen Sie in die erreichen Windows-API und konvertieren Sie es explizit mit WideCharToMultiByte und sehen, was Sie zurückbekommen. Sie finden ein VBA-Beispiel here.