Jeigu yra būdas padaryti geriau, atrask jį. T. A. Edison

Sveiki, Svečias
Prisijungimo vardas: Slaptažodis: Prisiminti mane
  • Puslapis:
  • 1

TEMA: Workbook Range Names

Workbook Range Names prieš 5 m. 4 mėn. #1

  • bankeris
  • bankeris avataras
  • Neprisijungęs
  • Moderatorius
  • C#, VB.NET, VBA, MS Access, VSTO
  • Žinutės: 70
  • Gauta padėka 8
  • Reputacija: 8
Sveiki, suradau įdomų dalyką kuris iš pradžių atrodė gan paprastas, bet kaip išspręsti su VBA pagalba aš kol kas neradau būdų. Rankiniu būdu sutvarkyti paprasta. Taigi pradėkim.

Įkėliau dokumentą "Sritys.xlsx", atsidarykite jį. Jame rasite 2 tuščius lapelius "Sheet1 (2)" ir "Sheet1". Tada atsidarome "Name Manager" kuris randasi per vidurį "Formulas" tab'e ties "Define Names" skiltimi, arba ant klaviatūros paspaudę ALT tada i, n, d raides, paspaudus raidę ją reiktų atleisti ir tada spausti kitą ir aišku eiliškumas yra svarbus. Kas nežinojot tai dabar žinosit, kad su klaviatūra galima iškviesti visas Excel funkcijas. Taigi atsidarius langui pamatysite mano 3 sritis: "Sritis1", "SRITIS2" ir "Gera_Sritis". Prisegu nuotrauką "sritis.png", kaip matote "Scope" stulpelyje nurodyta kam priklauso sritis, tai yra ar Sheet'ui ar visam Workbook'ui. Šitos sritys pilnai veikia ant abiejų lapelių. Originaliai sritys buvo sukurtos ant "Sheet1" lapelio, o po to padaryta lapelio kopija su dešiniu pelės klavišu.

Problema atsiranda tada kai mes ištrinam "Sheet1" lapelį, ištrynus gauname tokį vaizdą: prisegu "sritis2.png". Atsiranda #REF! įrašai tik ten kur sritis buvo priskirta visam Workbook'ui o ne Sheet'ui, o "Gera_Sritis" liko tvarkinga, nes jos buvo priskirtos kiekviena ant Sheet'o.

Užduotis su VBA pagalba ištrinti visas sritis kurios yra sugadintos, šiuo atveju "Sritis1" ir "SRITIS2" kurios turi #REF! įrašus.

Ką aš pats išbandžiau:

Šis kodas patikrina ar sritis priskirta Sheet'ui ar Workbook'ui. Patys galite paleisti kodą ir pamatyti rezultatus. Kadangi naudoju Debug.Print tai, kad pamatyti rezultatus atsidarius VBA reikia paspausti View->Immediate Window. Kaip ir viską tvarkingai surašo, bet problema atsiranda tada kai bandau ištrinti sritį kuri priklauso Workbook'ui. Atkomentuoti reiktų "sritis.Delete". VBA ištrina tvarkinga sritį kuri priklauso Sheet'ui, o ne Workbook'ui. "Durnumo" dėlei įrašiau sritis.Delete jeigu IF'as yra true, tada ištrina visas sritis kurios priklauso Sheet'ui...
Sub Sritys()
    Dim sritis As Name
    For Each sritis In Names
        If TypeOf sritis.Parent Is Worksheet Then
            Debug.Print sritis.Name & " priklauso " & sritis.Parent.Name
            'paliekam lokalu'
        Else
            Debug.Print sritis.Name & " priklauso " & sritis.Parent.Name
            'sritis.Delete 'istrinam kadangi ji priklauso Workbook'ui, palieku uzkomentuota '
        End If
    Next
End Sub

Tada išbandžiau kitokį būdą, kuris dėja, bet padaro tą patį ką ir viršuje esantis kodas, ištrina visus gerus įrašus ir palieka sritis kurios turi #REF!. Kiekvieną sritį patikrinu, ir jeigu randu kad ji turi reikšmę "#REF!" tada bandau ją ištrinti pagal indeksą :) bet.....
Sub sritis()
    For i = 1 To ActiveWorkbook.Names.Count
        If InStr(ActiveWorkbook.Names.Item(i).RefersTo, "#REF!") > 0 Then
            Debug.Print InStr(ActiveWorkbook.Names.Item(i).RefersTo, "#REF!")
            Debug.Print ActiveWorkbook.Names.Item(i).RefersToLocal
            ActiveWorkbook.Names.Item(i).Delete
        End If
    Next
End Sub

Aš galvoju čia problema, kad VBA trina įrašus pagal jų vardus, o čia jie dubliuojasi, todėl ištrina pirmą pasitaikiusi. Dar kilo mintis, pervadinti gerus(pirmus) įrašus ir tada ištrinti, bet neaišku ar visada geri įrašai bus pirmi.. :)
Priedai:
Nepamirškite teisingiems atsakymams paspausti "Padėkos"

I could change the world, if only they would give me the source code....
Paskutinis taisymas: prieš 5 m. 4 mėn. nuo bankeris.
Administratorius uždraudė viešą pranešimų rašymą.

Workbook Range Names prieš 5 m. 4 mėn. #2

  • ZygD
  • ZygD avataras
  • Neprisijungęs
  • Auksinis narys
  • Žinutės: 197
  • Gauta padėka 60
  • Reputacija: 20
O čia įdomų dalyką radai :)) Pabandžiau rasti būdą, kaip apeiti problemą, bet deja nesėkmingai.
Bandžiau per instr atsiradęs tinkamą name jį įtraukti į specialiai susikurtą class. Tai pavyko, tačiau tas .delete vis tiek turi savo veikimo specifiką ir ištrina ne tai, ko reikia.
Dar bandžiau name pakeisti (sritis.name = "kkk"), nustebau, bet irgi nepavyko. tai pavyksta tai tvarkingai sričiai, bet kai prieinama ta dubliuota, tai name nepasikeičia nei vienoje, nors kodas prasisuka ir jokio error neišmeta. Žodžiu tikrai keista. Dar gal nebuvau aptikęs tokių bugų.

Vienintelis variantas, kuris dar liko, tai įsirašyti į kokį nors array arba kelis kintamuosius srities pavadinimą, į kuriuos langelius referina, tada ištrinti visas tas sritis ir sukurti sritis iš naujo.
Administratorius uždraudė viešą pranešimų rašymą.

Workbook Range Names prieš 5 m. 4 mėn. #3

  • bankeris
  • bankeris avataras
  • Neprisijungęs
  • Moderatorius
  • C#, VB.NET, VBA, MS Access, VSTO
  • Žinutės: 70
  • Gauta padėka 8
  • Reputacija: 8
Aš ir bandžiau pakeisti vardus, ta pati nesąmonė. Klaidos nemeta ir nieko nepadaro.
Zyg D parašė:
Vienintelis variantas, kuris dar liko, tai įsirašyti į kokį nors array arba kelis kintamuosius srities pavadinimą, į kuriuos langelius referina, tada ištrinti visas tas sritis ir sukurti sritis iš naujo.

Kažkaip nepagalvojau apie šitą variantą :). Reiktų pamąstyti ir išmėginti.
Nepamirškite teisingiems atsakymams paspausti "Padėkos"

I could change the world, if only they would give me the source code....
Paskutinis taisymas: prieš 5 m. 4 mėn. nuo bankeris.
Administratorius uždraudė viešą pranešimų rašymą.

Workbook Range Names prieš 5 m. 4 mėn. #4

  • ups
  • ups avataras
  • Neprisijungęs
  • Veteranas
  • Žinutės: 67
  • Gauta padėka 24
  • Reputacija: 9
DĖMESIO: Spoileris! [ Spustelėkite, kad išplėsti ]


Kaip variantas, nors ir ne visai pagal sąlygą.
Ištriname lapą "Sheet1" ir
paleidžiame vieną kartą kodą ir žiūrime, kas lieka.
Paleidžiame antrą kartą kodą ir vėl žiūrime, kas lieka.
Paskutinis taisymas: prieš 5 m. 4 mėn. nuo ups.
Administratorius uždraudė viešą pranešimų rašymą.

Workbook Range Names prieš 5 m. 4 mėn. #5

  • bankeris
  • bankeris avataras
  • Neprisijungęs
  • Moderatorius
  • C#, VB.NET, VBA, MS Access, VSTO
  • Žinutės: 70
  • Gauta padėka 8
  • Reputacija: 8
Tai žinok "ups", tavo kodas ištrina gerus įrašus kaip ir pas mus. Nežinau ar pats bandei ? Šiandien prisėsiu Zyg D pasiūlymą įgyvendinti - perkurti visus per naujo prieš tai įkeliant į masyvą.
Nepamirškite teisingiems atsakymams paspausti "Padėkos"

I could change the world, if only they would give me the source code....
Administratorius uždraudė viešą pranešimų rašymą.

Workbook Range Names prieš 5 m. 4 mėn. #6

  • bankeris
  • bankeris avataras
  • Neprisijungęs
  • Moderatorius
  • C#, VB.NET, VBA, MS Access, VSTO
  • Žinutės: 70
  • Gauta padėka 8
  • Reputacija: 8
Palyginus kiek teko prirašyti ir į ką suprastinau tai juokas :|, bet užduotis įvykdyta. Aišku čia galima patoblunti porą vietų tikrai ir ten žemiau if'us galėjau suprastinti bet jau tiek tos. Jeigu kas sugalvosit paprastesnį variantą būtinai įdėkite/pasidalinkite. O jeigu kažkas nesuprantama irgi rašykite pasistengsiu paaiškinti.
Sub perkurti()
    Dim naikinti as boolean
    For Each ww In ActiveWorkbook.Names
        If InStr(ww.Value, "#REF") > 0 Or InStr(ww.RefersTo, "#REF") > 0 Then
            naikinti = True
            Exit For
        End If
    Next
 
    If Not naikinti Then Exit Sub
 
    Dim AltIND() As String
    Dim i As Integer
    Dim n As Integer
 
    n = ActiveWorkbook.Names.Count
    ReDim Preserve AltIND(n, 5) As String
 
    i = -1
    For Each dd In ActiveWorkbook.Names
        i = i + 1
        AltIND(i, 0) = dd.Name
        AltIND(i, 1) = dd.Value 'neveikia...'
        AltIND(i, 2) = dd.RefersTo
        AltIND(i, 3) = Lapelis(dd.RefersTo)
        AltIND(i, 4) = False 'Reiktų žiūrėti su klausimu: Ar trinti?'
    Next
 
    For Each dd In ActiveWorkbook.Names
        dd.Delete
    Next
 
    For i = 0 To n - 1
        If InStr(AltIND(i, 1), "#REF") > 0 Then
            AltIND(i, 4) = True
        End If
        If InStr(AltIND(i, 2), "#REF") > 0 Then
            AltIND(i, 4) = True
        End If
        If InStr(AltIND(i, 3), "#REF") > 0 Then
            AltIND(i, 4) = True
        End If
 
        If AltIND(i, 4) = False Then
            ActiveWorkbook.Worksheets(AltIND(i, 3)).Names.Add Name:=AltIND(i, 0), RefersTo:=AltIND(i, 2)
        End If
    Next
End Sub
 
Function Lapelis(ByVal lapas As String) As String
    Dim pabaiga As Integer
    Dim pradzia As Integer
    pabaiga = InStr(lapas, "!") - 2
    pradzia = InStr(lapas, "=") + 1
    Lapelis = Replace(Mid(lapas, pradzia, pabaiga), "'", "")
End Function
Nepamirškite teisingiems atsakymams paspausti "Padėkos"

I could change the world, if only they would give me the source code....
Paskutinis taisymas: prieš 5 m. 4 mėn. nuo bankeris.
Administratorius uždraudė viešą pranešimų rašymą.
  • Puslapis:
  • 1
Moderatoriai: bankeris
Puslapio sukūrimo laikas: 0.711 sekundžių