Başka bir Tablodaki tablo değerlerini güncelleştirme

Question

Yaklaşık 20000 satır boyutunda ve 52 sütun içeren bir çalışma kitabım var. Zaman zaman, bir seferde seçilen satırların yüzdesini güncellemem gerekiyor. Seçilmiş hücreleri, satırdaki bir değere göre güncelleştirmek için bir makro kullanmayı umuyordum, tablo 1'e girilecek güncellenmiş değerler ile ikinci bir küçük tabloyla eşleştirildi. Neredeyse bir VLOOKUP işlevi gibi Giriş bulunamazsa, hücreyi silmez. Örneğin, Telefon Numarasını Host ID'ye göre değiştirin.

Bunu, Tablo 1'deki değerlerin belirli bir kümesi için aşağıdaki kodda bir Array ile yapmaya çalıştım, ancak değerlerim güncellenmedi. VBA'm biraz paslı, bu yüzden birileri bunu gözden geçirip yardımcı olmak için yardımcı olabilirse takdir edilecektir. En sonunda tablo başlıklarına dayanarak tablodaki herhangi bir girişi güncellemek istiyorum.

Sub NewNameandCostCenter() 
Dim myList, myRange 
Dim sht As Worksheet 
Dim sht2 As Worksheet 
Dim LastRow As Long 
Dim LastColumn As Long 
Dim StartCell As Range 
Dim LastRow2 As Long 
Set sht = Worksheets("NewNameMacro") 
Set sht2 = Worksheets("ALL") 
Set StartCell = Range("A2") 

'Find Last Row and Column 
    LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row 
    LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column 
'set myList array 
Set myList = sht.Range(StartCell, sht.Cells(LastRow, LastColumn)) 
LastRow2 = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
'set myRange array 
Set myRange = Sheets("ALL").Range("J2:M" & LastRow2) 
'Update values of cells adjacent 
For Each cel In myList.Columns(1).Cells 
myRange.Replace What:=cel.Value, Replacement:=cel.Offset(0, 1).Value, LookAt:=xlWhole 
myRange.Replace What:=cel.Value, Replacement:=cel.Offset(0, 2).Value, LookAt:=xlWhole 
myRange.Replace What:=cel.Value, Replacement:=cel.Offset(0, 3).Value, LookAt:=xlWhole 
Next cel 
End Sub 

sayesinde JD Doğru, etkili bir şekilde eşleştirme tablosundaki değerlere dayalı verileriniz karşı bir UPDATE sorgusu çalıştırıyorsanız sorunuzu anlamak

Answer 1

.

• "anahtar" sütunu, eşleştirme tablosundaki veri tablosunun ve ilk sütundur:

  aşağıdaki varsaydım. Bu kolayca ayarlanabilir edilebilir ancak sizin eşleştirme tablosundaki

• kolonları (veri tablosunda sütunları aynı sırada ve bağıl konumdadırlar.

• haritalama masa ve anahtarların sırası veri tablosu sıralanmamış olduğunu. Eğer tuşlar (ideal iki tabakada da) sıralanır emin olabiliriz, o zaman bazı küçük değişiklikler içeren önemli ölçüde daha iyi performans elde olsaydı. Ben aralıkları kodlanmış ettik

benim Örnek, ancak gerekirse son satırı ve son sütun yaklaşımını yeniden kurabilirsiniz.

Tüm karşılaştırmaları aralıklar yerine diziler arasında yaptım ve Bul yaklaşımına son verdim. Bunun işe yaradığını ve daha verimli çalıştığını göreceksiniz.

50 of 20000 rows updated in 0.23828125 seconds

Ama satır binlerce güncellemeye başlamak gerekirse, o zaman veriler sıralanır sağlanması ve verdiği büyük fayda olacaktır:

Option Explicit 

Sub NewNameandCostCenter() 

    Dim start As Double 
    start = Timer 

    Dim countOfChangedRows As Long 

    'set rngMap array 
    Dim rngMap As Range 
    Set rngMap = Worksheets("Map").Range("A1:D51") 

    'set rngData array 
    Dim rngData As Range 
    Set rngData = Worksheets("Data").Range("J2:M20001") 

    Dim aMap As Variant 
    aMap = rngMap.Value 

    Dim aData As Variant 
    aData = rngData.Value 

    Dim mapRow As Long 
    Dim datarow As Long 
    Dim mapcol As Long 

    For mapRow = LBound(aMap, 1) To UBound(aMap, 1) 
    For datarow = LBound(aData) To UBound(aData) 
     'Check the key matches in both tables 
     If aData(datarow, 1) = aMap(mapRow, 1) Then 
     countOfChangedRows = countOfChangedRows + 1 
     'Assumes the columns in map and data match 
     For mapcol = LBound(aMap, 2) + 1 To UBound(aMap, 2) 
      aData(datarow, mapcol) = aMap(mapRow, mapcol) 
     Next mapcol 
     End If 
    Next datarow 
    Next mapRow 

    rngData.Value = aData 

    Debug.Print countOfChangedRows & " of "; UBound(aData, 1) & " rows updated in " & Timer - start & " seconds" 

End Sub 

performansı 50 güncellenen satırlar için makul buna göre kod.