BG Development


Страници: (2) [1] 2   ( Първото ново мнение ) Reply to this topicStart new topicStart Poll

> Ако някой може нека помогне, Помощ за VBA в Еxcel
Rocko74
Публикувано на: 01-02-2017, 16:58
Quote Post



Име: Росен Стоянов
Група: Потребител
Ранг: Новопостъпил

Мнения: 9
Регистриран на: 01.02.17



Здравейте
Първо да кажа,че аз нищо не разбирам от VBA
Второ търся помощ а не съвет как "да не се занимавам с неща, които не разбирам".
Трето Благодаря предварително на всеки който ще отдели време независимо дали ще може или не да ми помогне

Та трябва ми Макрос на VBA за една екселска таблица който да изпълнява следното:
В Sheat2 имам редове с данни като в колона А е записан „номер по ред“ от 1 до примерно 10000
В Sheat1 имам само един ред който искам като го попълня да намери в Sheat2 реда който има същия „номер по ред“ (примерно 10) и да замени съдържанието на целия ред с това от Sheat1.

Ако някой помогне ще съм много благодарен.
PMEmail Poster
Top
CPPlus
Публикувано на: 01-02-2017, 20:07
Quote Post



Име: Людмил Григоров
Група: Потребител
Ранг: Почетен член

Мнения: 1098
Регистриран на: 22.06.11



Това не може ли с екселски формули по-лесно да се направи? Иначе утре може да провериш евентуално ако съм написал макрото.
Едит: вероятно не може, ако искаш нещо като "tool" за променяне на записи за постоянно (с екселски формули).

Това мнение е било редактирано от CPPlus на 01-02-2017, 20:08


--------------------
Нищо не е свършило, докато не е свършило! Не се предавай и ще постигнеш целта си!
PMEmail Poster
Top
Rocko74
Публикувано на: 01-02-2017, 20:13
Quote Post



Име: Росен Стоянов
Група: Потребител
Ранг: Новопостъпил

Мнения: 9
Регистриран на: 01.02.17



Благодаря Ви за отделеното време, но на мен ми е нужен макрос, защото таблицата, която правя е с много връзки и това е част от връзките, които са ми необходими в нея. Още веднъж благодаря за вниманието.
PMEmail Poster
Top
Rocko74
  Публикувано на: 01-02-2017, 23:07
Quote Post



Име: Росен Стоянов
Група: Потребител
Ранг: Новопостъпил

Мнения: 9
Регистриран на: 01.02.17



Ето този макрос

Sub AAAA()
'
' AAAA Macro
' Macro recorded 1.2.2017 by Acer
'

'
Sheets("Sheet1").Select
Range("A1:G1").Select
Selection.Copy
Sheets("Sheet2").Select
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Select
ActiveSheet.Paste
End Sub

Тук се търси последната свободна клетка от първата колона(.End(xlUp).Row + 1, 1) а аз искам да го заменя с клетката в първа колона която има еднаква стойност с клетка А1 от Sheet1
За съжаление аз нищичко не вдявам.
Дано така да ме разберете правилно какво ми трябва.
PMEmail Poster
Top
CPPlus
Публикувано на: 02-02-2017, 07:24
Quote Post



Име: Людмил Григоров
Група: Потребител
Ранг: Почетен член

Мнения: 1098
Регистриран на: 22.06.11



В началото на RecordEditer избираш ControlSheet (от там edit-ваш записите) и TableSheet (там биват edit-вани записите).

Макрото предполага, че:
- всички записи са ти с еднакъв брой на полетата.
- нито един запис няма поле с празна клетка.
- записът в ControlSheet е на втори ред, като в първата клетка е id-то на записа, който ще променяш

CODE

Public ControlSheet As String
Public TableSheet As String

Sub RecordEditer()
   ControlSheet = "Sheet1"
   TableSheet = "Sheet2"
   
   Dim NewRecord() As Variant
   NewRecord = GetNewRecord
   
   ReplaceRecord (NewRecord)
End Sub

Function GetNewRecord()
   Dim Result() As Variant

   Dim WorkingRange As Range
   Set WorkingRange = ActiveWorkbook.Worksheets("Sheet1").Cells
   
   Dim Counter As Integer
   Counter = 1
   
   Dim CurrentCellValue As Variant
   CurrentCellValue = WorkingRange(2, Counter)
   
   ' Read to the end of the record (which is assumed to be an empty cell)
   While Replace(CurrentCellValue, " ", "") <> ""
       ReDim Preserve Result(Counter)
       Result(Counter) = CurrentCellValue
       
       Counter = Counter + 1
       CurrentCellValue = WorkingRange(2, Counter)
   Wend
   
   GetNewRecord = Result
End Function

Function ReplaceRecord(Record As Variant)
   Dim RecordId As Variant
   RecordId = Record(1)
   
   Dim OldRecordId As Integer
   OldRecordId = -1
   
   Dim OldRecordRowIndex As Integer
   OldRecordRowIndex = FindRowIndexById(TableSheet, RecordId)
   
   Dim Cells As Range
   Set Cells = ActiveWorkbook.Worksheets(TableSheet).Cells
   
   ' Replace.
   Dim Counter As Integer
   For Counter = 1 To UBound(Record, 1)
       Cells(OldRecordRowIndex, Counter).Value2 = Record(Counter)
   Next Counter
End Function

Function FindRowIndexById(SheetName As String, Id As Variant)
   Dim CurrentId As Variant
   CurrentId = -1
   
   Dim UsedRange As Range
   Set UsedRange = ActiveWorkbook.Worksheets(SheetName).UsedRange
   
   Dim Row As Range
   Dim RowIndex As Integer
   RowIndex = 1
   For Each Row In UsedRange.Rows
       CurrentId = Row(1).Cells(1).Value2
       If Id = CurrentId Then
           FindRowIndexById = RowIndex
           Exit Function
       End If
       RowIndex = RowIndex + 1
   Next Row
   
   FindRowIndexById = -1
End Function


Това мнение е било редактирано от CPPlus на 02-02-2017, 07:26


--------------------
Нищо не е свършило, докато не е свършило! Не се предавай и ще постигнеш целта си!
PMEmail Poster
Top
Rocko74
  Публикувано на: 02-02-2017, 07:58
Quote Post



Име: Росен Стоянов
Група: Потребител
Ранг: Новопостъпил

Мнения: 9
Регистриран на: 01.02.17



Oooo Човек много труд си хвърлил. Искрени благодарности.

За сега го гледам като голям камък и нещо не мога да го направя но се надявам, че като се поровичкам ще успея да го пусна. icon_lol.gif

Благодаря ти както за положения труд така и за времето което отдели
PMEmail Poster
Top
CPPlus
Публикувано на: 02-02-2017, 08:57
Quote Post



Име: Людмил Григоров
Група: Потребител
Ранг: Почетен член

Мнения: 1098
Регистриран на: 22.06.11



Защо не можеш да го пуснеш? Как опитваш?


--------------------
Нищо не е свършило, докато не е свършило! Не се предавай и ще постигнеш целта си!
PMEmail Poster
Top
Rocko74
Публикувано на: 02-02-2017, 09:16
Quote Post



Име: Росен Стоянов
Група: Потребител
Ранг: Новопостъпил

Мнения: 9
Регистриран на: 01.02.17



Ами както казах и преди аз нищо не разбирам от програмиране
явно тотално бъркам философията.
Влизам с Alt+F11 в Microsoft Visual Basic for Applications и в Module1 поставям кода
в Sheet1 си правя един графичен обект, след това десен бутон и избирам " Присвояване на Макрос " и избирам Module1.RecordEditer

- всички записи са ти с еднакъв брой полета.
- нито един запис няма поле с празна клетка.
- записът в ControlSheet е на втори ред, като в първата клетка е id.
PMEmail Poster
Top
CPPlus
Публикувано на: 02-02-2017, 09:37
Quote Post



Име: Людмил Григоров
Група: Потребител
Ранг: Почетен член

Мнения: 1098
Регистриран на: 22.06.11



user posted image
user posted image
user posted image


--------------------
Нищо не е свършило, докато не е свършило! Не се предавай и ще постигнеш целта си!
PMEmail Poster
Top
Rocko74
Публикувано на: 02-02-2017, 09:54
Quote Post



Име: Росен Стоянов
Група: Потребител
Ранг: Новопостъпил

Мнения: 9
Регистриран на: 01.02.17



При мен е така

Прикачена картинка (Кликнете на картинката, за да я увеличите!)
Прикачена картинка
PMEmail Poster
Top
0 потребители преглеждат тази тема в момента (0 гости, 0 анонимни потребители)
Потребители, преглеждащи темата в момента:

Topic Options Страници: (2) [1] 2  Reply to this topicStart new topicStart Poll

 


Copyright © 2003-2018 | BG Development | All Rights Reserved
RSS 2.0