Excel VBA, bitişik alanlara veri örtüşmesini kaldır

Question

Verilerin bitişik hücrelere üst üste binmesini kaldırmak için işlevi birleştiren bir VBA komut dosyası yazmaya çalışıyorum ve veriyi gösterildiği gibi veri uzunluğuna uyacak şekilde yeniden boyutlandırıyorum. takipler snaps.

1) Excel'de verilerin Orijinal düzeni

2) yanlarındaki tüm alanları

3) çift tıklayın seçmek için üst let köşesine tıklayın Veri uzunluklarına uyacak şekilde hücreleri yeniden boyutlandırmak için hücrelerdeki hücre.

Şu anda, aşağıda .HorizontalAlignment kullanıyorum ama çalışmıyor:

With wks 
    With .Cells(1, 1).CurrentRegion 
     lastCol = .Columns.Count 
     lastRow = .Rows.Count 
    End With 

    'Select the interested cells and insert borders around the interested fields 
    .UsedRange.Borders.LineStyle = xlContinuous 
    .UsedRange.HorizontalAlignment = xlLeft 
End With 

Answer 1

Sana Range.AutoFit yöntem arıyorsanız inanıyoruz.

Sub allFit() 
    Dim c As Long 

    With Worksheets("Sheet1") 
     With .Cells(1, 1).CurrentRegion 
      For c = 1 To .Columns.Count 
       With .Columns(c) 
        .WrapText = False 
        .AutoFit 
       End With 
      Next c 
     End With 
    End With 

End Sub 

Answer 2

Bunu kullanmayı deneyin. Kullanacağınız sayfayı ilk seçtiğiniz yeri seçin ve sonra Sütunlar üzerinde AutoFit işlevini kullanın (tüm sütunlar anlamına gelir) ve metin uzunluğuna göre sütunların boyutu olur. Ayrıca vb sadece bazı sütunları ve seçebilirsiniz ... ama onun farklı soru için

Sub adjustColumns() 
    Sheets("Sheet3").Columns.AutoFit 
End Sub