Tüm sayfalar için uygulanabilir Çalışma Sayfası_Değişimdeki belirli baytların belirli bayt karakterlerini sınırlayın

Question

Aşağıdaki gibi belirli uzunluklarda bir hücre değerini kısıtlayabilen kodu biliyorum, ancak bunu bayt olarak nasıl sınırlandıracağım, örneğin 240 bayt olarak diyelim. kesiştiği kadar sınırda? Ayrıca, Charset "shift-jis" yani Japonca + İngilizce olacaktır.

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 

Yardım minnettar!

Answer 1

Belirli charset temsil bayt sınırlı uzunlukta bir dize almak için ADODB.Stream ActiveX kullanabilirsiniz. Herhangi bir karakter belirtmediğiniz için örnek için UTF-8'u seçtim.Ben, Çalışma birime yerleştirilir aşağıdaki kodu kodunuzu modifiye ve LeftUTF8() fonksiyonu ekledi: temsil 240 bayt bir dize almak için kod

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 

GÜNCELLEME İşte

olan vardiya-JIS karakter kümesi:

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

Soruyu doğru anlıyorsam, sonuçta yapmanız gereken, bir karakterin ANSI karakter aralığına düşüp düşmediğini belirlemektir (bir baytla gösterilebilir - 0 - 255). Excel, yorumlarda belirtildiği gibi bunu kolaylaştırmaz. tüm dizeleri'u dahili olarak UTF-16 olarak gösterir. Bu, VB4'ten sonra VBA Len ve LenB davranışlarının değiştiği problemiyle birleştirilir. Bu değişiklikten önce, Unicode veya ANSI girişi için farklı sonuçlar vermiş olurlardı. LenB karakter başına hep 2 bayt dize bellek içi uzunluğu döndürdüğü için Şimdi, onlar aynı sonucu dönecektir hem. ANSI aralığını ayırt eden, 2 baytın daima sıfır olacağıdır.

StrConv işlevi, bir dizenin ANSI olmayan karakterler içerdiğini kontrol etmenin bir yolunu sağlar - Byte dizisine dönüştürebilir ve yüksek baytlardan herhangi birinin ayarlanıp ayarlanmadığını kontrol edebilirsiniz.

65 0 66 0 67 0 68 0 

Bu sonuçlanır StrConv("ABCD", vbUnicode) ile tekrar 2 byte , bu genişletmek için VBA'ın "Unicode dönüşüm" bir cilvesi kullanabilirsiniz: Örneğin, dize "ABCD" olarak VBA'ın belleğinde depolanır: Eğer (ıde yazmanız yolu yoktur çünkü olurdu) bir yerden dize "ΑΒΓΔ" aldı eğer karşılaştırma için

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

, bu kodlama bağlı bu sonuçlanabilir:

Eğer bir bayt dizisi bir kez 83

Yani, yapmanız gereken tek şey her byte kontrol edilir - Eğer sıfır olmayan bir değer bulmak, eğer ANSı'YE daralmış edilemez:

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 

ise kodlama bağlıdır daima

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

Not o bayt uzunluğu : İlgilendiğiniz her bunu 8 bite daralmış olabilir belirlemek kolayca sonra UTF-16 v ANSI, siz "bayt uzunluğu" yakalayabilir olduğunu. Belirli bir kodlamada dize uzunluğunu gerekiyorsa sabit bir genişlik kodlama olmadığı sürece, VBA çok doğal yardımcı olmak için gitmiyor (yani UTF-32, VBA olasılıkla zaten kasap), içine ulaşması gerekecek Windows API ve açıkça WideCharToMultiByte ile dönüştürün ve geri aldığınız şeyi görün. Bir VBA örnek here bulabilirsiniz.