Formül ile hücreye açıklama eklemek

[mehmet dur]

Merhaba
D sürücüsündeki bir excel sayfasının A sütunundaki verileri masaüstündeki başka bir sayfanın yine A sütununa formüllerle alıyoruz.
Yapmak istediğimiz, verileri aldığımız hücre dolu ise yanındaki hücredeki değeri formül ile yine A sütununa açıklama olarak eklemek istiyoruz.
Umarım anlatabilmişimdir. Teşekkür ederim.

 

[mehmet dur]

Arkadaşlar herhangi bir cevabı olan yok mu?

 

[Korhan Ayhan]

Açıklamayı hücreye makro ile eklemeniz gerekir.

 

[mehmet dur]

Teşekkür ederim Korhan bey
Araştırmama rağmen bulamayınca benzer soru soru soran arkadaşların cevaplarındaki kodları kendime uyarlamaya çalışıyordum.
Rica etsem sorum ile ilgili bir kod yazabilir misiniz?

 

[Korhan Ayhan]

Açıklamaya hangi dosyanın B sütunundaki değer gelecek.

 

[mehmet dur]

D sürücüsündeki dosyanın

 

[Korhan Ayhan]

Veriyi aldığınız formülü paylaşmanız mümkün mü?

 

[mehmet dur]

='\\10.40.1.2\Su Sirkülasyonu-ortak\Susirkulasyon masaüstü\SİRKÜLASYON PROGRAM\[SU SİRKÜLASYON.xlsm]KAYIT'!A1

 

[Korhan Ayhan]

Hücre boş olduğunda nasıl görünüyor..

 

[mehmet dur]

Boş görünüyor.

 

[mehmet dur]

Bu arada Korhan bey mesaim bitmek üzere cevaplarınıza ancak yarın saat 16:00 dan sonra bakabilirim. Bana vakit ayırdığınız için şimdiden çok teşekkür ederim.
Hayırlı geceler.

 

[Korhan Ayhan]

Yani formülü uyguladınız hedef dosyada ilgili hücre boş ise formüllü hücrede boş görünüyor. Doğru anladım sanırım..

 

[mehmet dur]

evet

 

[Korhan Ayhan]

Deneyiniz.

Dosya yolunu ve sayfa isimlerini kendi sisteminize göre revize edersiniz...

Option Explicit

Sub Update_Comments()
    Dim WB1 As String, WB2 As String, WS As Worksheet
    Dim My_Connection As Object, My_Recordset As Object
    Dim My_Query As String, My_Array As Variant
    Dim Rng As Range, X As Long
   
    WB1 = ActiveWorkbook.FullName
    WB2 = "D:\SU SİRKÜLASYON.xlsm"
    Set WS = ThisWorkbook.Sheets("Sheet1")
   
    Set My_Connection = VBA.CreateObject("AdoDB.Connection")
    Set My_Recordset = VBA.CreateObject("AdoDB.Recordset")
   
    On Error GoTo ErrorHandler
   
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & WB1 & _
                       ";Extended Properties=""Excel 12.0 Xml;HDR=No;IMEX=1"""
   
    My_Query = "SELECT T2.F2 " & _
               "FROM [" & WS.Name & "$A:A] AS T1 " & _
               "LEFT JOIN " & _
               "[Excel 12.0 Xml;HDR=No;IMEX=1;Database=" & WB2 & "].[KAYIT$A:B] AS T2 " & _
               "ON T1.F1 = T2.F1"
   
    Set My_Recordset = My_Connection.Execute(My_Query)
   
    My_Array = My_Recordset.GetRows
   
    For Each Rng In WS.Range("A1:A" & WS.Cells(WS.Rows.Count, 1).End(3).Row)
        With Rng
            If Not .Comment Is Nothing Then .Comment.Delete
            If .Value <> "" Then
                If Not IsNull(My_Array(0, X)) Then
                    .AddComment
                    .Comment.Text CStr(My_Array(0, X))
                End If
            End If
        End With
        X = X + 1
    Next

Cleanup:
    If My_Recordset.State <> 0 Then My_Recordset.Close
    If My_Connection.State <> 0 Then My_Connection.Close
    Set My_Recordset = Nothing
    Set My_Connection = Nothing
    Set WS = Nothing
    MsgBox "Açıklamalar güncellenmiştir.", vbInformation
    Exit Sub

ErrorHandler:
    MsgBox "Bir hata oluştu: " & Err.Description, vbCritical, "Hata"
    Resume Cleanup
End Sub