Przycinanie komórek przy użyciu języka VBA w programie Excel

Question

Mam coś, co wydaje się być prostym problemem z niektórymi danymi w programie Excel. Mam dużo danych z wiodącymi przestrzeniami wklejonymi ze stołu internetowego i chciałbym pozbyć się początkowej przestrzeni. Pobiegłem następujący kod (jestem całkowicie nowy w VBA), ale to nie działa. Kiedy przejdę przez to w debugerze, wygląda na nieskończoną pętlę. Każda pomoc będzie doceniona!

Sub DoTrim() 
    For Each cell In Selection.Cells 
    If cell.HasFormula = False Then 
     cell = Trim(cell) 
    End If 
    Next 
End Sub 

EDIT: To wygląda jak funkcja TRIM jest uruchomiony na problemy z charakterem „przestrzeń”. Ten kod:

Sub DoTrim() 
Dim cell As Range, areaToTrim As Range 
Set areaToTrim = Selection.Cells 
For Each cell In areaToTrim 
    cell.Value = "MUPPET" 
Next cell 
End Sub 

Zmieniono wartość komórek, więc domyślam się, że jest to spacja bez przestrzeni! Masz pomysł, jak się ich pozbyć?

Answer 1

Jeśli masz przed drukiem znak niedrukowalny spróbuj tego

Option Explicit 
Sub DoTrim() 
    Dim cell As Range 
    Dim str As String 
    Dim nAscii As Integer 
    For Each cell In Selection.Cells 
     If cell.HasFormula = False Then 
      str = Trim(CStr(cell)) 
      If Len(str) > 0 Then 
       nAscii = Asc(Left(str, 1)) 
       If nAscii < 33 Or nAscii = 160 Then 
        If Len(str) > 1 Then 
         str = Right(str, Len(str) - 1) 
        Else 
         strl = "" 
        End If 
       End If 
      End If 
      cell=str 
     End If 
    Next 
End Sub 

Answer 2

działa dobrze dla mnie z jedną zmianą - czwarta linia powinna być:

cell.Value = Trim(cell.Value) 

---

Edycja: Jeśli wydaje się tkwić w pętli, bym dodać

Debug.Print cell.Address 

wewnątrz pętli For ... Next, aby uzyskać nieco więcej informacji o tym, co się dzieje.

Podejrzewam również, że Trim usuwa tylko spacje - czy jesteś pewien, że nie masz tam innej formy wyświetlania?

Answer 3

Nieskończona pętla jest wynikiem oświadczenia On Error Resume Next gdzieś wyżej w kodzie. Pozbądź się go teraz. Jeśli Twój kod działa tylko z On Error Resume Next, to wymaga natychmiastowej i całkowitej reorganizacji.

I podczas gdy jesteś przy tym, umieść Option Explicit na wierzchu modułu. Zmusza do zadeklarowania wszystkich zmiennych, zabezpieczenie przed denerwującymi błędami, które są wynikiem błędnie wpisanych nazw zmiennych. (Można zmodyfikować preferencje edytora VBA, aby ta opcja została automatycznie ustawiona następnym razem, co jest wysoce zalecane.)

Bezpośrednim problemem z kodem jest to, że komórka jest obiektem, a obiektów nie można przyciąć. Chcesz przyciąć tekst komórki, więc musisz to zrobić:

cell.Text = Trim(cell.Text) 

Answer 4

Powinno to zrobić to, co chcesz zrobić. Właśnie przetestowałem to na mojej kartce; daj mi znać, jeśli to nie zadziała. LTrim jest, jeśli masz tylko wiodące spacje; Funkcja Trim może być używana tak samo, jak dba o miejsca wiodące i końcowe. Zastąp zakres komórek w obszarze, który mam jako "A1: C50", a także upewnij się, że zmieniasz "Arkusz1" na nazwę arkusza, nad którym pracujesz.

Dim cell As Range, areaToTrim As Range 
Set areaToTrim = Sheet1.Range("A1:C50") 
For Each cell In areaToTrim 
    cell.Value = LTrim(cell.Value) 
Next cell 

Answer 5

Chciałbym rozwiązać ten problem bez VBA. Po prostu wybierz tę przestrzeń i użyj wymiany (zmień na nic) w tym arkuszu, próbując pozbyć się tych spacji.

Jeśli naprawdę chcesz użyć VBA wierzę można wybrać pierwszy znak

strSpace = left(range("A1").Value,1) 

i używać zastąpienia funkcji w VBA w ten sam sposób

Range("A1").Value = Replace(Range("A1").Value, strSpace, "") 

lub

for each cell in selection.cells 
cell.value = replace(cell.value, strSpace, "") 
next 

Answer 6

To działa dobrze dla mnie. Używa tablicy, więc nie przechodzisz przez każdą komórkę. Działa znacznie szybciej w dużych sekcjach arkusza.

Sub Trim_Cells_Array_Method() 

Dim arrData() As Variant 
Dim arrReturnData() As Variant 
Dim rng As Excel.Range 
Dim lRows As Long 
Dim lCols As Long 
Dim i As Long, j As Long 

    lRows = Selection.Rows.count 
    lCols = Selection.Columns.count 

    ReDim arrData(1 To lRows, 1 To lCols) 
    ReDim arrReturnData(1 To lRows, 1 To lCols) 

    Set rng = Selection 
    arrData = rng.value 

    For j = 1 To lCols 
    For i = 1 To lRows 
     arrReturnData(i, j) = Trim(arrData(i, j)) 
    Next i 
    Next j 

    rng.value = arrReturnData 

    Set rng = Nothing 
End Sub 

Answer 7

Jedyną rzeczą, która pracowała dla mnie jest to funkcja:

Sub DoTrim() 
Dim cell As Range 
Dim str As String 
For Each cell In Selection.Cells 
    If cell.HasFormula = False Then 
     str = Left(cell.Value, 1) 'space 
     While str = " " Or str = Chr(160) 
      cell.Value = Right(cell.Value, Len(cell.Value) - 1) 
      str = Left(cell.Value, 1) 'space 
     Wend 
     str = Right(cell.Value, 1) 'space 
     While str = " " Or str = Chr(160) 
      cell.Value = Left(cell.Value, Len(cell.Value) - 1) 
      str = Right(cell.Value, 1) 'space 
     Wend 
    End If 
Next cell 
End Sub 

Answer 8

pracował dla mnie zupełnie jak ten:

wykadrowanie wszystkie zaznaczone komórki. Uważaj na wybór pełnych kolumn/wierszy: P.

Sub TrimSelected()  
Dim rng As Range, cell As Range  
Set rng = Selection 

For Each cell In rng  
cell = Trim(cell) 

Next cell  

End Sub