DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Bu şekilde bana uymuyor programa aktarma yapcam, veri aktarımı da makrodan otomatik yapıp " d" sutuna vermesini istiyorum, formül oldugu zaman muhasebe programı görmüyor çünküMerhaba,
=A1 & " " & B1 & " " & C1
Dosyanız eklenmemiş. Ancak anladığım kadarıyla Necdet beyin önerisini aşağıdaki gibi makro koduna çevirebilirsiniz.Bu şekilde bana uymuyor programa aktarma yapcam, veri aktarımı da makrodan otomatik yapıp " d" sutuna vermesini istiyorum, formül oldugu zaman muhasebe programı görmüyor çünkü
sub birlestir()
Range("D1")=Range("A1")&" "&Range("B1")&" "&Range("C1")
end sub
Fonksiyon bölümünde sorunca Necdet ne yapsın?Bu şekilde bana uymuyor programa aktarma yapcam, veri aktarımı da makrodan otomatik yapıp " d" sutuna vermesini istiyorum, formül oldugu zaman muhasebe programı görmüyor çünkü
hocam bunu 2. satır ile 8000. satır arasında yapmak gerekir ise nasıl yapabiliriz. b de saat var c den de soldan 3 harf alacak. yardımcı olur musunuz hocam. teşekkür ederim.Dosyanız eklenmemiş. Ancak anladığım kadarıyla Necdet beyin önerisini aşağıdaki gibi makro koduna çevirebilirsiniz.
Kod:sub birlestir() Range("D1")=Range("A1")&" "&Range("B1")&" "&Range("C1") end sub
Sub Birlestironi()
Dim sayfa As Worksheet
Set sayfa = ActiveSheet
sonsat = sayfa.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
Dim sonuc As String
For i = 2 To sonsat 'satır
For j = 1 To 2 'sütun adedi
For k = 3 To 3 'sütun adedi
If sayfa.Cells(i, j) <> "" Then
If sonuc <> "" Then
sonuc = sonuc & sayfa.Cells(i, j).Text & Left(sayfa.Cells(i, k).Text, 3)
Else
sonuc = sonuc & sayfa.Cells(i, j).Text
End If
End If
Next
sayfa.Cells(i, 4) = sonuc
Next
sonuc = ""
Next
End Sub
hocam bunu kendime uygulamayamadım.Deneyiniz...
Kod:Sub Birlestironi() Dim sayfa As Worksheet Set sayfa = ActiveSheet sonsat = sayfa.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row Dim sonuc As String For i = 2 To sonsat 'satır For j = 1 To 2 'sütun adedi For k = 3 To 3 'sütun adedi If sayfa.Cells(i, j) <> "" Then If sonuc <> "" Then sonuc = sonuc & sayfa.Cells(i, j).Text & Left(sayfa.Cells(i, k).Text, 3) Else sonuc = sonuc & sayfa.Cells(i, j).Text End If End If Next sayfa.Cells(i, 4) = sonuc Next sonuc = "" Next End Sub
08:30 MER ADA. | 1 Şubat 2022 Salı | 08:30 | - | MERSİN | ADANA |
Eğer soruya soru eklemeyecekseniz bunu 2 şekilde yapabilirsiniz.hocam bunu 2. satır ile 8000. satır arasında yapmak gerekir ise nasıl yapabiliriz. b de saat var c den de soldan 3 harf alacak. yardımcı olur musunuz hocam. teşekkür ederim.
=A2&METNEÇEVİR(B2;"ss:dd")&SOLDAN(C2;3)
Sub Makro1()
Dim i As Long
Application.ScreenUpdating = False
For i = 2 To Cells(Rows.Count, "A").End(3).Row
Range("D" & i) = Cells(i, "A") & Format(Cells(i, "B"), "hh:mm") & Left(Cells(i, "C"), 3)
Next i
Application.ScreenUpdating = True
End Sub
Sub M2()
Dim i As Long
Application.ScreenUpdating = False
For i = 2 To Cells(Rows.Count, "E").End(3).Row
Range("A" & i) = Format(Cells(i, "F"), "hh:mm") & " " & Left(Cells(i, "H"), 3) & " " & Left(Cells(i, "J"), 3) & "."
Next i
Application.ScreenUpdating = True
End Sub
Hocam teşekkür ederim. elinize ve emeğinize sağlıkDoğru anlamış isem:
Birleştirme yeri A sütununda olacak. (F saat &H ilk üç harf & J ilk üç harf )
Buna göre Necdet Bey'in formülünde biraz oynama yaparsak sanırım işlem tamam olacak.
Kod:Sub M2() Dim i As Long Application.ScreenUpdating = False For i = 2 To Cells(Rows.Count, "E").End(3).Row Range("A" & i) = Format(Cells(i, "F"), "hh:mm") & " " & Left(Cells(i, "H"), 3) & " " & Left(Cells(i, "J"), 3) & "." Next i Application.ScreenUpdating = True End Sub