- Katılım
- 16 Ocak 2009
- Mesajlar
- 69
- Excel Vers. ve Dili
- Excel Vers. ve Dili Ofis 2016 TR
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
F sütunundali verilerin diğer sütunlarla bir bağı var mı?
F sütununa veriyi siz elle girdiğinizde sayı olan ve tek basamaklı tüm içeriklerin başına Sıfırı otomatik mi koysun?
Parantezleri de mi koysun?
F sütunan verileri elle tek tek mi giriyorsunuz başka bir yerden Copy-Paste yaparak mı?
Sub TekHaneleriDuzelt()
Dim Veri, ListeN, ListeO, ListeQ
Dim x As Byte, i As Long, k As Integer, xLen As Integer, Bak As String, Say As String, YeniDeger As String
Veri = Range("N2:Q" & Range("N" & Rows.Count).End(3).Row).Value
ReDim ListeN(1 To UBound(Veri), 1 To 1)
ReDim ListeO(1 To UBound(Veri), 1 To 1)
ReDim ListeQ(1 To UBound(Veri), 1 To 1)
For x = 1 To 4
If x = 3 Then x = 4
For i = 1 To UBound(Veri)
Bak = Veri(i, x)
xLen = Len(Bak)
YeniDeger = ""
For k = 1 To xLen
Say = Mid(Bak, k, 1)
If IsNumeric(Mid(Bak, k, 1)) Then
If k = 1 And xLen = 1 Then
YeniDeger = YeniDeger & "0" & Say
ElseIf k = 1 And xLen > 1 And Not IsNumeric(Mid(Bak, 2, 1)) Then
YeniDeger = YeniDeger & "0" & Say
ElseIf k > 1 And xLen = 2 And Not IsNumeric(Left(Bak, 1)) Then
YeniDeger = YeniDeger & "0" & Say
ElseIf k > 1 And xLen > 2 And k < xLen And Not IsNumeric(Mid(Bak, k - 1, 1)) And Not IsNumeric(Mid(Bak, k + 1, 1)) Then
YeniDeger = YeniDeger & "0" & Say
ElseIf k = xLen And Not IsNumeric(Mid(Bak, k - 1, 1)) Then
YeniDeger = YeniDeger & "0" & Say
Else
YeniDeger = YeniDeger & Say
End If
Else
YeniDeger = YeniDeger & Say
End If
Next k
Select Case x
Case 1
ListeN(i, 1) = YeniDeger
Case 2
ListeO(i, 1) = YeniDeger
Case Else
ListeQ(i, 1) = YeniDeger
End Select
Next i
Next x
Range("N2").Resize(UBound(Veri), 1) = ListeN
Range("O2").Resize(UBound(Veri), 1) = ListeO
Range("Q2").Resize(UBound(Veri), 1) = ListeQ
Erase Veri: Erase ListeN: Erase ListeO: Erase ListeQ
End Sub
RegExp ile olur mu bilemedim. Beceremediğim bir konu.
Ancak aşağıdaki kodları bir Modüle içine yerleştirip sayfanızda çalıştırırsanız N-O-Q sütunlarında işlem yapmaktadır.
Çalıştırmadan önce dosyanın yedeğini almanızı tavsiye ederim.
C++:Sub TekHaneleriDuzelt() Dim Veri, ListeN, ListeO, ListeQ Dim x As Byte, i As Long, k As Integer, xLen As Integer, Bak As String, Say As String, YeniDeger As String Veri = Range("N2:Q" & Range("N" & Rows.Count).End(3).Row).Value ReDim ListeN(1 To UBound(Veri), 1 To 1) ReDim ListeO(1 To UBound(Veri), 1 To 1) ReDim ListeQ(1 To UBound(Veri), 1 To 1) For x = 1 To 4 If x = 3 Then x = 4 For i = 1 To UBound(Veri) Bak = Veri(i, x) xLen = Len(Bak) YeniDeger = "" For k = 1 To xLen Say = Mid(Bak, k, 1) If IsNumeric(Mid(Bak, k, 1)) Then If k = 1 And xLen = 1 Then YeniDeger = YeniDeger & "0" & Say ElseIf k = 1 And xLen > 1 And Not IsNumeric(Mid(Bak, 2, 1)) Then YeniDeger = YeniDeger & "0" & Say ElseIf k > 1 And xLen = 2 And Not IsNumeric(Left(Bak, 1)) Then YeniDeger = YeniDeger & "0" & Say ElseIf k > 1 And xLen > 2 And k < xLen And Not IsNumeric(Mid(Bak, k - 1, 1)) And Not IsNumeric(Mid(Bak, k + 1, 1)) Then YeniDeger = YeniDeger & "0" & Say ElseIf k = xLen And Not IsNumeric(Mid(Bak, k - 1, 1)) Then YeniDeger = YeniDeger & "0" & Say Else YeniDeger = YeniDeger & Say End If Else YeniDeger = YeniDeger & Say End If Next k Select Case x Case 1 ListeN(i, 1) = YeniDeger Case 2 ListeO(i, 1) = YeniDeger Case Else ListeQ(i, 1) = YeniDeger End Select Next i Next x Range("N2").Resize(UBound(Veri), 1) = ListeN Range("O2").Resize(UBound(Veri), 1) = ListeO Range("Q2").Resize(UBound(Veri), 1) = ListeQ Erase Veri: Erase ListeN: Erase ListeO: Erase ListeQ End Sub
Bu kodları yalnız B sütunundaki "Tarih" fotmatındaki değerlerin önüne sıfır koymak için nasıl kullanabilirm.RegExp ile olur mu bilemedim. Beceremediğim bir konu.
Ancak aşağıdaki kodları bir Modüle içine yerleştirip sayfanızda çalıştırırsanız N-O-Q sütunlarında işlem yapmaktadır.
Çalıştırmadan önce dosyanın yedeğini almanızı tavsiye ederim.
C++:Sub TekHaneleriDuzelt() Dim Veri, ListeN, ListeO, ListeQ Dim x As Byte, i As Long, k As Integer, xLen As Integer, Bak As String, Say As String, YeniDeger As String Veri = Range("N2:Q" & Range("N" & Rows.Count).End(3).Row).Value ReDim ListeN(1 To UBound(Veri), 1 To 1) ReDim ListeO(1 To UBound(Veri), 1 To 1) ReDim ListeQ(1 To UBound(Veri), 1 To 1) For x = 1 To 4 If x = 3 Then x = 4 For i = 1 To UBound(Veri) Bak = Veri(i, x) xLen = Len(Bak) YeniDeger = "" For k = 1 To xLen Say = Mid(Bak, k, 1) If IsNumeric(Mid(Bak, k, 1)) Then If k = 1 And xLen = 1 Then YeniDeger = YeniDeger & "0" & Say ElseIf k = 1 And xLen > 1 And Not IsNumeric(Mid(Bak, 2, 1)) Then YeniDeger = YeniDeger & "0" & Say ElseIf k > 1 And xLen = 2 And Not IsNumeric(Left(Bak, 1)) Then YeniDeger = YeniDeger & "0" & Say ElseIf k > 1 And xLen > 2 And k < xLen And Not IsNumeric(Mid(Bak, k - 1, 1)) And Not IsNumeric(Mid(Bak, k + 1, 1)) Then YeniDeger = YeniDeger & "0" & Say ElseIf k = xLen And Not IsNumeric(Mid(Bak, k - 1, 1)) Then YeniDeger = YeniDeger & "0" & Say Else YeniDeger = YeniDeger & Say End If Else YeniDeger = YeniDeger & Say End If Next k Select Case x Case 1 ListeN(i, 1) = YeniDeger Case 2 ListeO(i, 1) = YeniDeger Case Else ListeQ(i, 1) = YeniDeger End Select Next i Next x Range("N2").Resize(UBound(Veri), 1) = ListeN Range("O2").Resize(UBound(Veri), 1) = ListeO Range("Q2").Resize(UBound(Veri), 1) = ListeQ Erase Veri: Erase ListeN: Erase ListeO: Erase ListeQ End Sub