Kod Düzenleme

shuker · 18 Aralık 2023

Sub Test()
Dim ws As Worksheet
Dim satir21, satir22, satir23, satir24, satir25, satir26, satir27, satir28, satir29, satir30, satir31, satir32, sonDoluSuton As Integer
Dim birlesmisHucresi1, birlesmisHucresi2 As Range

' Çalışmak istediğiniz sayfa
Set ws = ThisWorkbook.Sheets("KAPAK") ' Sayfa1'i kendi sayfa adınıza göre güncelleyin

' 21. Satır, 22. Satır, 23.Satır, 24. Satır 25. Satır, 26. Satır, 27. Satır, 28. Satır, 29. Satır, 30. Satır, 31. Satır, 32. Satır '
satir21 = 21
satir22 = 22
satir23 = 23
satir24 = 24
satir25 = 25
satir26 = 26
satir27 = 27
satir28 = 28
satir29 = 29
satir30 = 30
satir31 = 31
satir32 = 32

' 21. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir21, ws.Columns.Count).End(xlToLeft).Column

' 21. satırdaki son dolu sütunun sonraki 3 sütunu birleştir
ws.Range(ws.Cells(satir21, sonDoluSuton + 1), ws.Cells(satir21, sonDoluSuton + 2)).Merge

' 22. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir22, ws.Columns.Count).End(xlToLeft).Column

' 22. satırdaki son dolu sütunun sonraki 3 sütunu birleştir
ws.Range(ws.Cells(satir22, sonDoluSuton + 1), ws.Cells(satir22, sonDoluSuton + 3)).Merge

' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir21, sonDoluSuton + 1), ws.Cells(satir21, sonDoluSuton + 3))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir22, sonDoluSuton + 1), ws.Cells(satir22, sonDoluSuton + 3))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge

' Birleştirilen hücreye "KG" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir21, sonDoluSuton + 1)
.Value = "KG"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = True
.Interior.Color = RGB(192, 192, 192) ' Açık gri renk
End With

' 23. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir23, ws.Columns.Count).End(xlToLeft).Column

' 23. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir23, sonDoluSuton + 1), ws.Cells(satir23, sonDoluSuton + 1)).Merge

' 24. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir24, ws.Columns.Count).End(xlToLeft).Column

' 24. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir24, sonDoluSuton + 1), ws.Cells(satir24, sonDoluSuton + 1)).Merge

' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir23, sonDoluSuton + 1), ws.Cells(satir23, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir24, sonDoluSuton + 1), ws.Cells(satir24, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge

' Birleştirilen hücreye "ÇİĞ DEPO" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir23, sonDoluSuton + 1)
.Value = "ÇİĞ DEPO"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With

' 25. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir25, ws.Columns.Count).End(xlToLeft).Column

' 25. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir25, sonDoluSuton + 1), ws.Cells(satir25, sonDoluSuton + 1)).Merge

' 26. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir26, ws.Columns.Count).End(xlToLeft).Column

' 26. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir26, sonDoluSuton + 1), ws.Cells(satir26, sonDoluSuton + 1)).Merge

' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir25, sonDoluSuton + 1), ws.Cells(satir25, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir26, sonDoluSuton + 1), ws.Cells(satir26, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge

' Birleştirilen hücreye "TEMİZ" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir25, sonDoluSuton + 1)
.Value = "TEMİZ"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With

' 27. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir27, ws.Columns.Count).End(xlToLeft).Column

' 27. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir27, sonDoluSuton + 1), ws.Cells(satir27, sonDoluSuton + 1)).Merge

' 28. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir28, ws.Columns.Count).End(xlToLeft).Column

' 28. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir28, sonDoluSuton + 1), ws.Cells(satir28, sonDoluSuton + 1)).Merge

' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir27, sonDoluSuton + 1), ws.Cells(satir27, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir28, sonDoluSuton + 1), ws.Cells(satir28, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge

' Birleştirilen hücreye "1A+AZ+P" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir27, sonDoluSuton + 1)
.Value = "1A+AZ+P"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With

' 29. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir29, ws.Columns.Count).End(xlToLeft).Column

' 29. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir29, sonDoluSuton + 1), ws.Cells(satir29, sonDoluSuton + 1)).Merge

' 30. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir30, ws.Columns.Count).End(xlToLeft).Column

' 30. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir30, sonDoluSuton + 1), ws.Cells(satir30, sonDoluSuton + 1)).Merge

' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir29, sonDoluSuton + 1), ws.Cells(satir29, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir30, sonDoluSuton + 1), ws.Cells(satir30, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge

' Birleştirilen hücreye "GENEL FİRE" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir29, sonDoluSuton + 1)
.Value = "GENEL FİRE"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With

' 31. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir31, ws.Columns.Count).End(xlToLeft).Column

' 31. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir31, sonDoluSuton + 1), ws.Cells(satir31, sonDoluSuton + 1)).Merge

' 32. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir32, ws.Columns.Count).End(xlToLeft).Column

' 32. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir32, sonDoluSuton + 1), ws.Cells(satir32, sonDoluSuton + 1)).Merge

' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir31, sonDoluSuton + 1), ws.Cells(satir31, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir32, sonDoluSuton + 1), ws.Cells(satir32, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge

' Birleştirilen hücreye "GERÇEK FİRE" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir31, sonDoluSuton + 1)
.Value = "GERÇEK FİRE"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With
End Sub

Merhaba, yukarıdaki gibi kodum var fakat kodlar istediğim yerlerde 4 kenarıda ince kenarlık olacak şekilde yapılandırıyorum ama sadece üst kenarlığı koyuyor. 4 kenarlığıda çizdirip kodu iki satır aşşağıdan başlatmam mümkünmü. yani işlemleri yaptıktan sonra yazdığım kodu iki satır aşşağıya çekerek düzenlesin. ve kodu sadeleştirebilirmiyim. daha ekleyeceğim çok satır var. yük oluyor bu şekilde

Korhan Ayhan · 18 Aralık 2023

Kenarlık olayını aşağıdaki gibi halledebilirsiniz.

C++:

Option Explicit

Sub Add_Borders()
    Range("A1:K20").Borders.LineStyle = 1
End Sub

Kodları kısaltmak içinse döngüleri öğrenmeniz gerekir.

https://www.youtube.com/results?search_query=VBA+D%C3%96NG%C3%9CLER

MusaPEKEL · 18 Aralık 2023

shuker' Alıntı:
Sub Test()
Dim ws As Worksheet
Dim satir21, satir22, satir23, satir24, satir25, satir26, satir27, satir28, satir29, satir30, satir31, satir32, sonDoluSuton As Integer
Dim birlesmisHucresi1, birlesmisHucresi2 As Range

' Çalışmak istediğiniz sayfa
Set ws = ThisWorkbook.Sheets("KAPAK") ' Sayfa1'i kendi sayfa adınıza göre güncelleyin

' 21. Satır, 22. Satır, 23.Satır, 24. Satır 25. Satır, 26. Satır, 27. Satır, 28. Satır, 29. Satır, 30. Satır, 31. Satır, 32. Satır '
satir21 = 21
satir22 = 22
satir23 = 23
satir24 = 24
satir25 = 25
satir26 = 26
satir27 = 27
satir28 = 28
satir29 = 29
satir30 = 30
satir31 = 31
satir32 = 32

' 21. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir21, ws.Columns.Count).End(xlToLeft).Column

' 21. satırdaki son dolu sütunun sonraki 3 sütunu birleştir
ws.Range(ws.Cells(satir21, sonDoluSuton + 1), ws.Cells(satir21, sonDoluSuton + 2)).Merge

' 22. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir22, ws.Columns.Count).End(xlToLeft).Column

' 22. satırdaki son dolu sütunun sonraki 3 sütunu birleştir
ws.Range(ws.Cells(satir22, sonDoluSuton + 1), ws.Cells(satir22, sonDoluSuton + 3)).Merge

' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir21, sonDoluSuton + 1), ws.Cells(satir21, sonDoluSuton + 3))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir22, sonDoluSuton + 1), ws.Cells(satir22, sonDoluSuton + 3))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge

' Birleştirilen hücreye "KG" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir21, sonDoluSuton + 1)
.Value = "KG"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = True
.Interior.Color = RGB(192, 192, 192) ' Açık gri renk
End With

' 23. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir23, ws.Columns.Count).End(xlToLeft).Column

' 23. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir23, sonDoluSuton + 1), ws.Cells(satir23, sonDoluSuton + 1)).Merge

' 24. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir24, ws.Columns.Count).End(xlToLeft).Column

' 24. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir24, sonDoluSuton + 1), ws.Cells(satir24, sonDoluSuton + 1)).Merge

' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir23, sonDoluSuton + 1), ws.Cells(satir23, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir24, sonDoluSuton + 1), ws.Cells(satir24, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge

' Birleştirilen hücreye "ÇİĞ DEPO" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir23, sonDoluSuton + 1)
.Value = "ÇİĞ DEPO"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With

' 25. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir25, ws.Columns.Count).End(xlToLeft).Column

' 25. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir25, sonDoluSuton + 1), ws.Cells(satir25, sonDoluSuton + 1)).Merge

' 26. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir26, ws.Columns.Count).End(xlToLeft).Column

' 26. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir26, sonDoluSuton + 1), ws.Cells(satir26, sonDoluSuton + 1)).Merge

' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir25, sonDoluSuton + 1), ws.Cells(satir25, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir26, sonDoluSuton + 1), ws.Cells(satir26, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge

' Birleştirilen hücreye "TEMİZ" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir25, sonDoluSuton + 1)
.Value = "TEMİZ"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With

' 27. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir27, ws.Columns.Count).End(xlToLeft).Column

' 27. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir27, sonDoluSuton + 1), ws.Cells(satir27, sonDoluSuton + 1)).Merge

' 28. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir28, ws.Columns.Count).End(xlToLeft).Column

' 28. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir28, sonDoluSuton + 1), ws.Cells(satir28, sonDoluSuton + 1)).Merge

' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir27, sonDoluSuton + 1), ws.Cells(satir27, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir28, sonDoluSuton + 1), ws.Cells(satir28, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge

' Birleştirilen hücreye "1A+AZ+P" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir27, sonDoluSuton + 1)
.Value = "1A+AZ+P"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With

' 29. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir29, ws.Columns.Count).End(xlToLeft).Column

' 29. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir29, sonDoluSuton + 1), ws.Cells(satir29, sonDoluSuton + 1)).Merge

' 30. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir30, ws.Columns.Count).End(xlToLeft).Column

' 30. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir30, sonDoluSuton + 1), ws.Cells(satir30, sonDoluSuton + 1)).Merge

' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir29, sonDoluSuton + 1), ws.Cells(satir29, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir30, sonDoluSuton + 1), ws.Cells(satir30, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge

' Birleştirilen hücreye "GENEL FİRE" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir29, sonDoluSuton + 1)
.Value = "GENEL FİRE"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With

' 31. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir31, ws.Columns.Count).End(xlToLeft).Column

' 31. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir31, sonDoluSuton + 1), ws.Cells(satir31, sonDoluSuton + 1)).Merge

' 32. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir32, ws.Columns.Count).End(xlToLeft).Column

' 32. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir32, sonDoluSuton + 1), ws.Cells(satir32, sonDoluSuton + 1)).Merge

' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir31, sonDoluSuton + 1), ws.Cells(satir31, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir32, sonDoluSuton + 1), ws.Cells(satir32, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge

' Birleştirilen hücreye "GERÇEK FİRE" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir31, sonDoluSuton + 1)
.Value = "GERÇEK FİRE"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With
End Sub

Merhaba, yukarıdaki gibi kodum var fakat kodlar istediğim yerlerde 4 kenarıda ince kenarlık olacak şekilde yapılandırıyorum ama sadece üst kenarlığı koyuyor. 4 kenarlığıda çizdirip kodu iki satır aşşağıdan başlatmam mümkünmü. yani işlemleri yaptıktan sonra yazdığım kodu iki satır aşşağıya çekerek düzenlesin. ve kodu sadeleştirebilirmiyim. daha ekleyeceğim çok satır var. yük oluyor bu şekilde

C++:

Sub Duzenle()
    Dim ws As Worksheet
    Dim satir As Integer, sonDoluSuton As Integer
    Dim mergeRange As Range
    Dim ibare As String
    
    ' Çalışmak istediğiniz sayfa
    Set ws = ThisWorkbook.Sheets("KAPAK") ' Sayfa adını güncelleyin
    
    ' Satırların birleştirileceği sütun
    Dim birlesmeSutunu As Integer
    birlesmeSutunu = 3 ' Örnek olarak 3. sütunu kullanabilirsiniz
    
    For satir = 21 To 32
        ' Satırdaki son dolu sütunu bul
        sonDoluSuton = ws.Cells(satir, ws.Columns.Count).End(xlToLeft).Column
        
        ' İbare belirleme
        Select Case satir
            Case 21: ibare = "KG"
            Case 23: ibare = "ÇİĞ DEPO"
            Case 25: ibare = "TEMİZ"
            Case 27: ibare = "1A+AZ+P"
            Case 29: ibare = "GENEL FİRE"
            Case 31: ibare = "GERÇEK FİRE"
        End Select
        
        ' Birleştirilecek hücre aralığını belirle
        Set mergeRange = ws.Range(ws.Cells(satir, sonDoluSuton + 1), ws.Cells(satir, sonDoluSuton + birlesmeSutunu))
        
        ' Hücreleri birleştir
        mergeRange.Merge
        
        ' Birleştirilen hücreye ibare ekle, ortala, bold yap ve çerçeve çiz
        With ws.Cells(satir, sonDoluSuton + 1)
            .Value = ibare
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlCenter
            .Font.Bold = True
            .Borders.LineStyle = xlContinuous
            .Borders.Weight = xlThin
            .Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .WrapText = True
            .Orientation = 0
        End With
    Next satir
End Sub

shuker · 19 Aralık 2023

MusaPEKEL' Alıntı:

C++:

Sub Duzenle()
    Dim ws As Worksheet
    Dim satir As Integer, sonDoluSuton As Integer
    Dim mergeRange As Range
    Dim ibare As String
  
    ' Çalışmak istediğiniz sayfa
    Set ws = ThisWorkbook.Sheets("KAPAK") ' Sayfa adını güncelleyin
  
    ' Satırların birleştirileceği sütun
    Dim birlesmeSutunu As Integer
    birlesmeSutunu = 3 ' Örnek olarak 3. sütunu kullanabilirsiniz
  
    For satir = 21 To 32
        ' Satırdaki son dolu sütunu bul
        sonDoluSuton = ws.Cells(satir, ws.Columns.Count).End(xlToLeft).Column
      
        ' İbare belirleme
        Select Case satir
            Case 21: ibare = "KG"
            Case 23: ibare = "ÇİĞ DEPO"
            Case 25: ibare = "TEMİZ"
            Case 27: ibare = "1A+AZ+P"
            Case 29: ibare = "GENEL FİRE"
            Case 31: ibare = "GERÇEK FİRE"
        End Select
      
        ' Birleştirilecek hücre aralığını belirle
        Set mergeRange = ws.Range(ws.Cells(satir, sonDoluSuton + 1), ws.Cells(satir, sonDoluSuton + birlesmeSutunu))
      
        ' Hücreleri birleştir
        mergeRange.Merge
      
        ' Birleştirilen hücreye ibare ekle, ortala, bold yap ve çerçeve çiz
        With ws.Cells(satir, sonDoluSuton + 1)
            .Value = ibare
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlCenter
            .Font.Bold = True
            .Borders.LineStyle = xlContinuous
            .Borders.Weight = xlThin
            .Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .WrapText = True
            .Orientation = 0
        End With
    Next satir
End Sub

Merhaba, kodu denedim fakat
Select Case satir
Case 21: ibare = "KG"
Case 23: ibare = "ÇİĞ DEPO"
Case 25: ibare = "TEMİZ"
Case 27: ibare = "1A+AZ+P"
Case 29: ibare = "GENEL FİRE"
Case 31: ibare = "GERÇEK FİRE" bu ibareleri ikişer kere yazıyor ve boşluktan sonraki tüm 3 satırları birleştiriyor. ben sadece KG yazan alanı son dolu sütundan itibaren 2 satır 3 sütun birleştirmesini diğerlerinde ise 2 satır 1 sütun birleştirilecek şekilde olmalıydı. isteğimi bir örnek ile göstereyim.

İndir Kadife

Dosyayı indir Kadife

dosya.co

örnek dosya ektedir. dosyanın sağ tarafı ilk hali sol tarafı ise yapılmak istenen.

şimdiden tesekkür ederim.

shuker · 25 Aralık 2023

shuker' Alıntı:
Merhaba, kodu denedim fakat
Select Case satir
Case 21: ibare = "KG"
Case 23: ibare = "ÇİĞ DEPO"
Case 25: ibare = "TEMİZ"
Case 27: ibare = "1A+AZ+P"
Case 29: ibare = "GENEL FİRE"
Case 31: ibare = "GERÇEK FİRE" bu ibareleri ikişer kere yazıyor ve boşluktan sonraki tüm 3 satırları birleştiriyor. ben sadece KG yazan alanı son dolu sütundan itibaren 2 satır 3 sütun birleştirmesini diğerlerinde ise 2 satır 1 sütun birleştirilecek şekilde olmalıydı. isteğimi bir örnek ile göstereyim.

İndir Kadife

Dosyayı indir Kadife

dosya.co

örnek dosya ektedir. dosyanın sağ tarafı ilk hali sol tarafı ise yapılmak istenen.

şimdiden tesekkür ederim.

Sanırım bu konuda tek başıma kaldım konu ilerlemedi. isterseniz konuya kilit koyun ben uğraşmaya devam edeyim. konu açık kalmasın yardım etmeye calisanlara tesekkürler

Kod Düzenleme

shuker

Korhan Ayhan

Administrator

MusaPEKEL

shuker

İndir Kadife

shuker

İndir Kadife