Премини към съдържанието
Форумът в приложение

По-лесно сърфиране. Научи повече.
Kaldata.com - Форуми

Приложение на форума на цял екран с push известия, значки и други.

За да инсталирате това приложение на iOS и iPadOS
  1. Докоснете Иконата за споделяне в Safari
  2. Превъртете менюто и докоснете Добавяне към началния екран.
  3. Докоснете Добавяне в горния десен ъгъл.
За да инсталирате това приложение на Android
  1. Докоснете менюто с 3 точки (⋮) в горния десен ъгъл на браузъра.
  2. Докоснете Добавяне към началния екран или Инсталиране на приложение.
  3. Потвърдете, като докоснете Инсталиране.
Добави Kaldata.com в предпочитани източници в Google

Добре дошли!

Добре дошли в нашите форуми, пълни с полезна информация. Имате проблем с компютъра или телефона си? Публикувайте нова тема и ще намерите решение на всичките си проблеми. Общувайте свободно и открийте безброй нови приятели.

Моля, регистрирайте се за да публикувате тема и да получите пълен достъп до всички функции.

 

малко помощ за EXCEL

erudita
в Програми - Проблеми и Дискусии

Featured Replies

Не сработва, защото не съм копирал както трябва кирилицата, когато съм поствал кода:

'  D14 change and K14

If Target.Address = "$D$14" Then


  If (Worksheets("Sheet1").Range("K14").Value = "А") Then

	col = "G"

  ElseIf (Worksheets("Sheet1").Range("K14").Value = "Б") Then

	col = "H"

  ElseIf (Worksheets("Sheet1").Range("K14").Value = "ББ") Then

	col = "I"

  ElseIf (Worksheets("Sheet1").Range("K14").Value = "СМА") Then

	col = "J"

  End If


  lr = 11

  While Worksheets("Sheet2").Range(col & lr).Value <> ""

	lr = lr + 1

  Wend

  If (lr > 34) And (lr < 62) Then

	lr = 62

  End If


  While Worksheets("Sheet2").Range(col & lr).Value <> ""

	lr = lr + 1

  Wend


  If ((lr >= 11) And (lr <= 34)) Or ((lr >= 62) And (lr <= 85)) Then

	If Worksheets("Sheet2").Range(col & lr).Value <> "" Then lr = lr + 1

	Worksheets("Sheet2").Range(col & lr).Value = Worksheets("Sheet1").Range("D14").Value

  End If

End If

Ако пак не се копират кирилските букви, си ги напиши на ръка.

Редактирано от Ken (преглед на промените)

  • Автор

Кен , почти всичко е перфектно , но за съжаление има някои проблеми sad.gif

Има ли начин от лист 2, клетките под АБ, Б, ББ и СМА да приемат само една стойност. Идеята е, че когато се смени означението в клетка К14 от лист1 от АБ на Б напр. новата стойност се изписва на същия ред, а трябва да се премести на долния. Предвид когато се въведе АБ в клетка К14 и стойност в клетка D14 от лист 1,се попълва клетка G11 от лист 2, намираща се под клетка АБ със стойността на D14 от лист1. всичко дотук е ОК. когато обаче се промени K14 на СМА и съответно D14 ( и двете от лист1) в лист2 под клетка СМА се появява новата стойност на D14 в J11, но двете стойности стават на един ред, а трябва да се слиза един надолу и да се появи в J12- на един ред под клетките АБ< АБ, Б , ББ и СМА трябва да има само една стойност.....олеле майко незнам дали става ясно. форумът не прикачва екселски файлове за съжаление sad.gif

Кен , почти всичко е перфектно , но за съжаление има някои проблеми sad.gif

Има ли начин от лист 2, клетките под АБ, Б, ББ и СМА да приемат само една стойност. Идеята е, че когато се смени означението в клетка К14 от лист1 от АБ на Б напр. новата стойност се изписва на същия ред, а трябва да се премести на долния. Предвид когато се въведе АБ в клетка К14 и стойност в клетка D14 от лист 1,се попълва клетка G11 от лист 2, намираща се под клетка АБ със стойността на D14 от лист1. всичко дотук е ОК. когато обаче се промени K14 на СМА и съответно D14 ( и двете от лист1) в лист2 под клетка СМА се появява новата стойност на D14 в J11, но двете стойности стават на един ред, а трябва да се слиза един надолу и да се появи в J12- на един ред под клетките АБ< АБ, Б , ББ и СМА трябва да има само една стойност.....олеле майко незнам дали става ясно. форумът не прикачва екселски файлове за съжаление sad.gif

Ами архивирай го, или го преименувай на нещо друго.

Пробвай:

' D14 change and K14

If Target.Address = "$D$14" Then

If (Worksheets("Sheet1").Range("K14").Value = "À") Then

col = "G"

ElseIf (Worksheets("Sheet1").Range("K14").Value = "Á") Then

col = "H"

ElseIf (Worksheets("Sheet1").Range("K14").Value = "ÁÁ") Then

col = "I"

ElseIf (Worksheets("Sheet1").Range("K14").Value = "ÑÌÀ") Then

col = "J"

End If

lr = 11

If Worksheets("Sheet2").Range("G65535").End(xlUp).Row > lr Then

lr = Worksheets("Sheet2").Range("G65535").End(xlUp).Row

ElseIf Worksheets("Sheet2").Range("H65535").End(xlUp).Row > lr Then

lr = Worksheets("Sheet2").Range("H65535").End(xlUp).Row

ElseIf Worksheets("Sheet2").Range("I65535").End(xlUp).Row > lr Then

lr = Worksheets("Sheet2").Range("I65535").End(xlUp).Row

ElseIf Worksheets("Sheet2").Range("J65535").End(xlUp).Row > lr Then

lr = Worksheets("Sheet2").Range("J65535").End(xlUp).Row

End If

lr = lr + 1

If ((lr >= 11) And (lr <= 34)) Or ((lr >= 62) And (lr <= 85)) Then

If Worksheets("Sheet2").Range(col & lr).Value <> "" Then lr = lr + 1

Worksheets("Sheet2").Range(col & lr).Value = Worksheets("Sheet1").Range("D14").Value

End If

End If

Редактирано от Ken (преглед на промените)

  • Автор

дава ми комплексна грешка ElseIf (Worksheets("Sheet1").Range("K14").Value = "ÑÌÀ

") Then col = "J"

...ако може например, когато една от четирите клетки в реда приеме съответната стойност, другите да се заключват , за да се преминава на долния ред sad.gif

дава ми комплексна грешка ElseIf (Worksheets("Sheet1").Range("K14").Value = "ÑÌÀ

") Then col = "J"

...ако може например, когато една от четирите клетки в реда приеме съответната стойност, другите да се заключват , за да се преминава на долния ред sad.gif

за съжаление ме притискат да ставам, лек ден за сега и благодарности за всичко , Кен :hush: до скоро

дава ми комплексна грешка ElseIf (Worksheets("Sheet1").Range("K14").Value = "ÑÌÀ

") Then col = "J"

...ако може например, когато една от четирите клетки в реда приеме съответната стойност, другите да се заключват , за да се преминава на долния ред sad.gif

за съжаление ме притискат да ставам, лек ден за сега и благодарности за всичко , Кен :huh: до скоро

Пак е заради символите н акирилица, и бързането ми:

Ето го целия код, който при мен работи :

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo BadChange

Application.EnableEvents = False

If Target.Address = "$A$1" Then

  lr = 1

  While Worksheets("Sheet2").Range("A" & lr).Value <> ""

	lr = lr + 1

  Wend

  Worksheets("Sheet2").Range("A" & lr).Value = Worksheets("Sheet1").Range("A1").Value

End If



'  I7 change

If Target.Address = "$I$7" Then

  lr = 11

  While Worksheets("Sheet2").Range("B" & lr).Value <> ""

	lr = lr + 1

  Wend

  If (lr > 34) And (lr < 62) Then

	lr = 62

  End If


  While Worksheets("Sheet2").Range("B" & lr).Value <> ""

	lr = lr + 1

  Wend


  If ((lr >= 11) And (lr <= 34)) Or ((lr >= 62) And (lr <= 85)) Then

	If Worksheets("Sheet2").Range("B" & lr).Value <> "" Then lr = lr + 1

	Worksheets("Sheet2").Range("B" & lr).Value = Worksheets("Sheet1").Range("I7").Value

  End If

End If


'  A14 change

If Target.Address = "$A$14" Then

  lr = 11

  While Worksheets("Sheet2").Range("D" & lr).Value <> ""

	lr = lr + 1

  Wend

  If (lr > 34) And (lr < 62) Then

	lr = 62

  End If


  While Worksheets("Sheet2").Range("D" & lr).Value <> ""

	lr = lr + 1

  Wend


  If ((lr >= 11) And (lr <= 34)) Or ((lr >= 62) And (lr <= 85)) Then

	If Worksheets("Sheet2").Range("D" & lr).Value <> "" Then lr = lr + 1

	Worksheets("Sheet2").Range("D" & lr).Value = Worksheets("Sheet1").Range("A14").Value

  End If

End If


'  B14 change

If Target.Address = "$B$14" Then

  lr = 11

  While Worksheets("Sheet2").Range("E" & lr).Value <> ""

	lr = lr + 1

  Wend

  If (lr > 34) And (lr < 62) Then

	lr = 62

  End If


  While Worksheets("Sheet2").Range("E" & lr).Value <> ""

	lr = lr + 1

  Wend


  If ((lr >= 11) And (lr <= 34)) Or ((lr >= 62) And (lr <= 85)) Then

	If Worksheets("Sheet2").Range("E" & lr).Value <> "" Then lr = lr + 1

	Worksheets("Sheet2").Range("E" & lr).Value = Worksheets("Sheet1").Range("B14").Value

  End If

End If


'  E14 change

If Target.Address = "$E$14" Then

  lr = 11

  While Worksheets("Sheet2").Range("F" & lr).Value <> ""

	lr = lr + 1

  Wend

  If (lr > 34) And (lr < 62) Then

	lr = 62

  End If


  While Worksheets("Sheet2").Range("F" & lr).Value <> ""

	lr = lr + 1

  Wend


  If ((lr >= 11) And (lr <= 34)) Or ((lr >= 62) And (lr <= 85)) Then

	If Worksheets("Sheet2").Range("F" & lr).Value <> "" Then lr = lr + 1

	Worksheets("Sheet2").Range("F" & lr).Value = Worksheets("Sheet1").Range("E14").Value

  End If

End If



'  D14 change and K14

If Target.Address = "$D$14" Then


  If (Worksheets("Sheet1").Range("K14").Value = "А") Then

	col = "G"

  ElseIf (Worksheets("Sheet1").Range("K14").Value = "Б") Then

	col = "H"

  ElseIf (Worksheets("Sheet1").Range("K14").Value = "ББ") Then

	col = "I"

  ElseIf (Worksheets("Sheet1").Range("K14").Value = "СМА") Then

	col = "J"

  End If


  lr = 11


  If Worksheets("Sheet2").Range("G65535").End(xlUp).Row > lr Then

  lr = Worksheets("Sheet2").Range("G65535").End(xlUp).Row

  ElseIf Worksheets("Sheet2").Range("H65535").End(xlUp).Row > lr Then

  lr = Worksheets("Sheet2").Range("H65535").End(xlUp).Row

  ElseIf Worksheets("Sheet2").Range("I65535").End(xlUp).Row > lr Then

  lr = Worksheets("Sheet2").Range("I65535").End(xlUp).Row

  ElseIf Worksheets("Sheet2").Range("J65535").End(xlUp).Row > lr Then

  lr = Worksheets("Sheet2").Range("J65535").End(xlUp).Row

  End If

  lr = lr + 1


  If ((lr >= 11) And (lr <= 34)) Or ((lr >= 62) And (lr <= 85)) Then

	If Worksheets("Sheet2").Range(col & lr).Value <> "" Then lr = lr + 1

	Worksheets("Sheet2").Range(col & lr).Value = Worksheets("Sheet1").Range("D14").Value

  End If

End If




BadChange:

Application.EnableEvents = True

End Sub

  • Автор

Здравей, Кен! днес дано остане време да обобщя нещата , надявам се , че всичко ще е ОК. Лек ден от мен:)

  • Автор

' D14 change and K14

If Target.Address = "$D$14" Then

If (Worksheets("Sheet1").Range("K14").Value = "À") Then

col = "G"

ElseIf (Worksheets("Sheet1").Range("K14").Value = "Á") Then

col = "H"

ElseIf (Worksheets("Sheet1").Range("K14").Value = "ÁÁ") Then

col = "I"

ElseIf (Worksheets("Sheet1").Range("K14").Value = "ÑÌÀ") Then

col = "J"

End If

lr = 11

If Worksheets("Sheet2").Range("G65535").End(xlUp).Row > lr Then

lr = Worksheets("Sheet2").Range("G65535").End(xlUp).Row

ElseIf Worksheets("Sheet2").Range("H65535").End(xlUp).Row > lr Then

lr = Worksheets("Sheet2").Range("H65535").End(xlUp).Row

ElseIf Worksheets("Sheet2").Range("I65535").End(xlUp).Row > lr Then

lr = Worksheets("Sheet2").Range("I65535").End(xlUp).Row

ElseIf Worksheets("Sheet2").Range("J65535").End(xlUp).Row > lr Then

lr = Worksheets("Sheet2").Range("J65535").End(xlUp).Row

End If

lr = lr + 1

If ((lr >= 11) And (lr <= 34)) Or ((lr >= 62) And (lr <= 85)) Then

If Worksheets("Sheet2").Range(col & lr).Value <> "" Then lr = lr + 1

Worksheets("Sheet2").Range(col & lr).Value = Worksheets("Sheet1").Range("D14").Value

End If

End If

изглежда аз не успявам да направя нещо както трябва, но горното не ми се получава;(..иначе попълвам в кода АБ, Б, ББ и СМА(да не са маймуни), но когато правя промени те не се отразяват в посочените клеткиsad.gif

  • Автор
Не знам. При мен работи.

Предложих ти, да ми изпратиш файла, ако искаш.

скайп , имел нещо :tease:

скайп , имел нещо :)

...да ми дадеш предвид:)

Регистрирайте се или влезете в профила си за да коментирате
Назад

Разглеждащи това в момента 0

  • Няма регистрирани потребители разглеждащи тази страница.

Дарение

  • Подкрепи съществуването на форума - направи дарение
    32%
    Дарени 315 € от нужните 1 000 €

Бюлетин

Получавайте известие, когато има важна промяна или новина свързана с форума.
Абонирайте се

Профил

Навигация

Търсене

Търсене

Конфигуриране на push известия в браузъра
Chrome (Android)
  1. Докоснете иконата на катинар до адресната лента.
  2. Докоснете Разрешения → Известия.
  3. Променете предпочитанията си.
Chrome (Desktop)
  1. Кликнете върху иконата на катинар в адресната лента.
  2. Изберете Настройки на сайта.
  3. Намерете Известия и коригирайте предпочитанията си.