İki textboxta yer alan değerler VT de var ise üçüncü textboxtaki değeride ekleme

[hsayar]

aşağıdaki kodlar tblSAHIS tabosundaki veriler ile textbox a girdiğim veriler eşleşiyorsa listbox a listeliyorum. ancak istediğim listboa a listelemek değil textbox3 te yazılı olan ILCE KODU nu bu alanlara eklemektir. Bunun için kırmızı renkli alanı nasıl değiştirmeliyim. yardımlşarınız için şimdiden teşekkür eder saygılarımı sunarım.

Option Explicit

 Private Const kynKMLIK         As String = _
                                "C:\HSR\HsPrjSAHISTAKIP\HsDatabase\vtKISIGIRIS-ILCEKODGIR.mdb"
                                
                                
  Private Const sqlBAS_SAHIS     As String = _
                                "tblSAHIS.VATNO, tblSAHIS.SHS_ADI, tblSAHIS.SHS_SOYADI"
                                
  Private Const sqlBAS_SHS_2     As String = _
                                "tblSAHIS.SHS_NKOIL, tblSAHIS.SHS_NKOILCE"
                               'tblSAHIS.SHS_NKOILCEKODU,
                                'SHS_NKOILCEKODU
 Private Const sqlBAS_SECMEN     As String = _
                                "tblSECMEN.Kimlik, tblSECMEN.VATNO, tblSECMEN.SCM_ID, " & _
                                "tblSECMEN.SCM_IL, tblSECMEN.SCM_ILCE, tblSECMEN.SCM_MUHTARLIK, " & _
                                "tblSECMEN.SCM_SANDIKNO, tblSECMEN.SCM_SECMENNO, " & _
                                "tblSECMEN.SCM_TARIHI, tblSECMEN.SCM_SANDIKSIRANO, " & _
                                "tblSECMEN.SCM_SANDIKALANADI"
 
 Private Const sqlGRP_SECMEN     As String = _
                                "tblSECMEN.SCM_ID, " & _
                                "tblSECMEN.SCM_IL, tblSECMEN.SCM_ILCE, tblSECMEN.SCM_MUHTARLIK, " & _
                                "tblSECMEN.SCM_SANDIKNO, tblSECMEN.SCM_SECMENNO, " & _
                                "tblSECMEN.SCM_TARIHI, tblSECMEN.SCM_SANDIKSIRANO, " & _
                                "tblSECMEN.SCM_SANDIKALANADI"

  Private conNFS          As ADODB.Connection            'ADODB bağlantı değişkeni tanımla
  Private recNFS          As ADODB.Recordset             'ADODB kayıt alan değişkeni tanımla
  Private sqlSTR          As String                      'ADO Sorgusundaki başlıklar ve tablo
  Private sqlTBL          As String                      'ADO Sorgusundaki sadece tablo/sayfa
  Private boolNFSKYDBAG   As Boolean
  Private boolNFKYVAR     As Boolean


  Sub sbNFSKYTBAG_AC()
    Const PrcStr As String = "sbNFSKYTBAG_AC()"
    If Dir(kynKMLIK) = "" Then
        MsgBox kynKMLIK & " " & Chr(10) & " Dosyası Bulunamadı.", vbInformation, "Bilgi"
        boolNFSKYDBAG = False
    Else
        Set conNFS = CreateObject("ADODB.Connection")
        With conNFS
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .Properties("Data Source").Value = kynKMLIK
            .CursorLocation = adUseServer
            .Mode = adModeReadWrite
            .Open
        End With
        boolNFSKYDBAG = True
    End If
  End Sub
  
  Sub sbNFSKYTBAGKES()
    Const PrcStr As String = "Baglantıyı_Kes()"
    On Error Resume Next
    If CBool(recNFS.State And adStateOpen) = True Then recNFS.Close '?
      Set recNFS = Nothing    'değişkeni hafızadan sil
    If CBool(conNFS.State And adStateOpen) = True Then conNFS.Close '?
      Set conNFS = Nothing  'değişkeni hafızadan sil
  End Sub

  Private Sub cmdSORGU_Click()
      
      sbNFSKYTBAG_AC
      If boolNFSKYDBAG = False Then GoTo exitPROC
      Dim SqlSrg As String
  Rem *\*\*\*\*\*\*\*\*\*\**\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\
     SqlSrg = "tblSAHIS.SHS_NKOIL = " & "'" & txtSHS_NKOILADI.Text & "'" & " AND " & _
             "tblSAHIS.SHS_NKOILCE = " & "'" & txtSHS_NKOILCEADI.Text & "'"

      Set recNFS = CreateObject("ADODB.Recordset")    'kayıt bağlantısını kur
      sqlSTR = " SELECT " & sqlBAS_SHS_2 & " FROM [tblSAHIS] " & _
               " WHERE " & SqlSrg
          
          With recNFS
            .Open sqlSTR, conNFS, adOpenKeyset, adLockOptimistic
            If .RecordCount = 0 Then
              MsgBox "kayıt bulunamadı"
              GoTo exitPROC
            Else
            
            
[B][COLOR=Red]              With lbxSECMEN
                .ColumnCount = recNFS.Fields.Count
                .Column = recNFS.GetRows
                .TextAlign = fmTextAlignRight
                .SpecialEffect = fmSpecialEffectFlat
              End With 'ListBox1[/COLOR][/B]
              
            End If
          End With
          Set recNFS = Nothing
  Rem */*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/
  
  
   
exitPROC:
  Call sbNFSKYTBAGKES
  End Sub

 

[dost]

Merhaba,

.MoveFirst
Do While Not .EOF
("ILCE KODU") = textbox3
.MoveNext
Loop

Kolay gelsin.

 

[hsayar]

ilginize teşekkürler deneme yanılma ile bende başka türlü buldum.
Ancak bir sorun var işlem çok uzun sürüyor. (bir kayıt 3 dk) eşleşen her kaydı bulup istenilen değeri ekliyor.
ben değerleri daha sonra (1055 ilçe) for next ile yazdıracağım için (1055*3) 3150 dk yaklaişık 5 saat makinem kilitlenir.

   Private Sub cmdSORGU_Click()
  ZAMANBAS = Now()
      
      Call sbNFSKYTBAG_AC
      'If boolNFSKYDBAG = False Then GoTo exitPROC
      Dim SqlSrg As String
  Rem *\*\*\*\*\*\*\*\*\*\**\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\
     SqlSrg = " tblSAHIS.SHS_NKOIL = " & "'" & txtSHS_NKOILADI.Text & "'" & " AND " & _
              " tblSAHIS.SHS_NKOILCE = " & "'" & txtSHS_NKOILCEADI.Text & "'" '& " AND " & _
              " tblSAHIS.SHS_NKOILCEKODU = " & "'" & Null & "'"

      Set recNFS = CreateObject("ADODB.Recordset")    'kayıt bağlantısını kur
      sqlSTR = " SELECT " & sqlBAS_SHS_2 & " FROM [tblSAHIS] " & _
               " WHERE " & SqlSrg
          
          With recNFS
            .Open sqlSTR, conNFS, adOpenKeyset, adLockOptimistic
            If .RecordCount = 0 Then
              MsgBox "kayıt bulunamadı"
              GoTo exitPROC
            Else
            'Eşleşmenin sağlandığı tüm alanlarda alanlara sabit veri ekle.
              Do Until .EOF
                .Fields("SHS_NKOILCEKODU").Value = txtSHS_NKOILCEKODU.Text
                SAY = SAY + 1
                .Update
                .MoveNext
              Loop
              MsgBox SAY & "/" & .RecordCount & " kayıda ilçe kodu eklenmiştir."
            End If
          End With
          Set recNFS = Nothing
  Rem */*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/
  
  
   
exitPROC:
  Call sbNFSKYTBAGKES
  ZAMANBTS = Now()
  MsgBox "Süre: " & Format((ZAMANBTS - ZAMANBAS), "hh:mm:ss.dd")
  End Sub

 

[dost]

Merhaba,

Bu kadar sürmesi demek, kodlarda prb var demektir.

İstersen debug'layıp problemin nerde olduğunu görürsün.

Kolay gelsin.