помогите разобраться, VBA / Microsoft Office

ReSQL.ru

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Новые сообщения | Избранное

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / помогите разобраться, VBA

14 сообщений из 14, страница 1 из 1

помогите разобраться, VBA

#34493642

maccen

Участник

Сообщения: 167

Рейтинг: 0 / 0

Как уменьшить код?
суть в том, есть файлик
файл 1 - в перовм есть данные в столбце например AJ36
файл 2 - в этот файлик нужно данный из файла 1, столбец AJ36 перенести только уже в строчку
например:
файл 1:
100
200
300
400
....
1000
файл 2:
100 200 300 400 ... 1000
Есть код такого рода, только как его уменьшить...зарание спасибо!

ublic Sub Kyst0() FilePath = Workbooks("04_Zag_zvit.xls").Path + "\" Workbooks.Open (FilePath + "kystu\04\01.xls") Workbooks("04_Zag_zvit.xls").Worksheets("01").Cells(4 3).Value = Workbooks("01.xls").Worksheets("01").Cells(135 4).Value Workbooks("04_Zag_zvit.xls").Worksheets("01").Cells(4 4).Value = Workbooks("01.xls").Worksheets("01").Cells(136 4).Value Workbooks("04_Zag_zvit.xls").Worksheets("01").Cells(4 5).Value = Workbooks("01.xls").Worksheets("01").Cells(137 4).Value Workbooks("04_Zag_zvit.xls").Worksheets("01").Cells(4 6).Value = Workbooks("01.xls").Worksheets("01").Cells(138 4).Value Workbooks("04_Zag_zvit.xls").Worksheets("01").Cells(4 7).Value = Workbooks("01.xls").Worksheets("01").Cells(139 4).Value ").Worksheets("01").Cells(146 4).Value Workbooks("01.xls").Close (False)End Sub

...

Рейтинг:

0 / 0

27.04.2007, 17:02:03

| Ответить | Цитировать | Написать

помогите разобраться, VBA

#34493660

vbapro

Участник

Сообщения: 1 112

Рейтинг: 0 / 0

форматируй код в формуме кнопкой SRC

...

Рейтинг:

0 / 0

27.04.2007, 17:07:26

| Ответить | Цитировать | Написать

помогите разобраться, VBA

#34493692

maccen

Участник

Сообщения: 167

Рейтинг: 0 / 0

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.

ublic Sub Kyst0() 
FilePath = Workbooks("04_Zag_zvit.xls").Path + "\" 
Workbooks.Open (FilePath + "kystu\04\01.xls") 
 
Workbooks("04_Zag_zvit.xls").Worksheets("01").Cells( 4 ,  3 ).Value = Workbooks("01.xls").Worksheets("01").Cells( 135 ,  4 ).Value 
Workbooks("04_Zag_zvit.xls").Worksheets("01").Cells( 4 ,  4 ).Value = Workbooks("01.xls").Worksheets("01").Cells( 136 ,  4 ).Value 
Workbooks("04_Zag_zvit.xls").Worksheets("01").Cells( 4 ,  5 ).Value = Workbooks("01.xls").Worksheets("01").Cells( 137 ,  4 ).Value 
Workbooks("04_Zag_zvit.xls").Worksheets("01").Cells( 4 ,  6 ).Value = Workbooks("01.xls").Worksheets("01").Cells( 138 ,  4 ).Value 
Workbooks("04_Zag_zvit.xls").Worksheets("01").Cells( 4 ,  7 ).Value = Workbooks("01.xls").Worksheets("01").Cells( 139 ,  4 ).Value 
 
Workbooks("01.xls").Close (False) 
End Sub

...

Рейтинг:

0 / 0

27.04.2007, 17:19:13

| Ответить | Цитировать | Написать

помогите разобраться, VBA

#34493702

vbapro

Участник

Сообщения: 1 112

Рейтинг: 0 / 0

если это не программно, то попробуй копировать, потом специальная вставка+ галочка транспонировать. если программно - запиши макрорекордером и подправь

...

Рейтинг:

0 / 0

27.04.2007, 17:25:10

| Ответить | Цитировать | Написать

помогите разобраться, VBA

#34493714

maccen

Участник

Сообщения: 167

Рейтинг: 0 / 0

да лучше макросом, просто много кода до 2500 тыс строк

...

Рейтинг:

0 / 0

27.04.2007, 17:30:13

| Ответить | Цитировать | Написать

помогите разобраться, VBA

#34493749

vbapro

Участник

Сообщения: 1 112

Рейтинг: 0 / 0

...

Рейтинг:

0 / 0

27.04.2007, 17:42:05

| Ответить | Цитировать | Написать

помогите разобраться, VBA

#34493794

maccen

Участник

Сообщения: 167

Рейтинг: 0 / 0

спасибо за файлик, только если это все будет делать юзер каждый день, они меня пристрелят точно, может есть еще проще вариант?

...

Рейтинг:

0 / 0

27.04.2007, 17:56:02

| Ответить | Цитировать | Написать

помогите разобраться, VBA

#34493929

vbapro

Участник

Сообщения: 1 112

Рейтинг: 0 / 0

так ты возьми за основу код, и подредактируй. или опиши детально задачу: откуда куда, когда :) и т.д. чтоб можно было конкретный код сделать

...

Рейтинг:

0 / 0

27.04.2007, 18:53:23

| Ответить | Цитировать | Написать

помогите разобраться, VBA

#34494176

Deggasad

Участник

Откуда: Воронеж

Сообщения: 3 509

Рейтинг: 0 / 0

Если говорить конкретно о твоём примере, и о том как его сделать правильнее, то так

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.

Public Sub Kyst0()
FilePath = Workbooks("04_Zag_zvit.xls").Path + "\"
Workbooks.Open (FilePath + "kystu\04\01.xls")

Workbooks("04_Zag_zvit.xls").Worksheets("01"). _
    Range(Cells( 4 ,  3 ).Address, Cells( 4 ,  7 ).Address).Value = _
WorksheetFunction.Transpose(Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 135 ,  4 ).Address, Cells( 139 ,  4 ).Address).Value)

Workbooks("01.xls").Close (False)
End Sub

...

Рейтинг:

0 / 0

27.04.2007, 22:44:41

| Ответить | Цитировать | Написать

помогите разобраться, VBA

#34494186

Deggasad

Участник

Откуда: Воронеж

Сообщения: 3 509

Рейтинг: 0 / 0

Или что-то вроде этого

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.

Public Sub Kyst1()
FilePath = Workbooks("04_Zag_zvit.xls").Path + "\"
Workbooks.Open (FilePath + "kystu\04\01.xls")
Dim FromRNG As Range
Dim ToRNG As Range

Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("01"). _
    Range(Cells( 4 ,  3 ).Address, Cells( 4 ,  7 ).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 135 ,  4 ).Address, Cells( 139 ,  4 ).Address)

For n =  1  To ToRNG.Count
ToRNG(n).Value = FromRNG(n).Value
Next n

Workbooks("01.xls").Close (False)
End Sub

или как vbapro предложил специальная вставка

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.

Public Sub Kyst1()
FilePath = Workbooks("04_Zag_zvit.xls").Path + "\"
Workbooks.Open (FilePath + "kystu\04\01.xls")
Dim FromRNG As Range
Dim ToRNG As Range

Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("01"). _
    Range(Cells( 4 ,  3 ).Address, Cells( 4 ,  7 ).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 135 ,  4 ).Address, Cells( 139 ,  4 ).Address)

    FromRNG.Copy
    ToRNG.Worksheet.Activate
    ToRNG.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

Workbooks("01.xls").Close (False)
End Sub

...

Рейтинг:

0 / 0

27.04.2007, 22:54:42

| Ответить | Цитировать | Написать

помогите разобраться, VBA

#34501914

maccen

Участник

Сообщения: 167

Рейтинг: 0 / 0

вот столкнулся проблемой, не грузится ничего, и не матерится... в чом я что-то не так сделал?

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.

Public Sub Kyst1()
FilePath = Workbooks("04_Zag_zvit.xls").Path + "\"
Workbooks.Open (FilePath + "kystu\04\01.xls")
Dim FromRNG As Range
Dim ToRNG As Range
' íîâàÿ ñòðàíè÷êà ______1
Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("Ïðèõ³ä"). _
    Range(Cells( 5 ,  3 ).Address, Cells( 5 ,  14 ).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 4 ,  36 ).Address, Cells( 14 ,  36 ).Address)
  
 ' íîâàÿ ñòðàíè÷êà ______2
  Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("Ïðèõ³ä"). _
    Range(Cells( 5 ,  19 ).Address, Cells( 5 ,  30 ).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 4 ,  36 ).Address, Cells( 14 ,  36 ).Address)

   ' íîâàÿ ñòðàíè÷êà ______3
  Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("Ïðèõ³ä"). _
    Range(Cells( 5 ,  35 ).Address, Cells( 5 ,  46 ).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 4 ,  36 ).Address, Cells( 14 ,  36 ).Address)
  
     ' íîâàÿ ñòðàíè÷êà ______4
  Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("Ïðèõ³ä"). _
    Range(Cells( 5 ,  51 ).Address, Cells( 5 ,  62 ).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 4 ,  36 ).Address, Cells( 14 ,  36 ).Address)


     ' íîâàÿ ñòðàíè÷êà ______5
  Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("Ïðèõ³ä"). _
    Range(Cells( 5 ,  67 ).Address, Cells( 5 ,  78 ).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 4 ,  36 ).Address, Cells( 14 ,  36 ).Address)
  
    ' íîâàÿ ñòðàíè÷êà ______6
  Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("Ïðèõ³ä"). _
    Range(Cells( 5 ,  83 ).Address, Cells( 5 ,  94 ).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 4 ,  36 ).Address, Cells( 14 ,  36 ).Address)
 
   ' íîâàÿ ñòðàíè÷êà ______7
  Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("Ïðèõ³ä"). _
    Range(Cells( 5 ,  99 ).Address, Cells( 5 ,  110 ).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 4 ,  36 ).Address, Cells( 14 ,  36 ).Address)
    ' íîâàÿ ñòðàíè÷êà ______8
  Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("Ïðèõ³ä"). _
    Range(Cells( 5 ,  115 ).Address, Cells( 5 ,  126 ).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 4 ,  36 ).Address, Cells( 14 ,  36 ).Address)
    ' íîâàÿ ñòðàíè÷êà ______9
     ' íîâàÿ ñòðàíè÷êà ______9
  Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("Ïðèõ³ä"). _
    Range(Cells( 5 ,  131 ).Address, Cells( 5 ,  142 ).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 4 ,  36 ).Address, Cells( 14 ,  36 ).Address)

  ' íîâàÿ ñòðàíè÷êà ______10
  Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("Ïðèõ³ä"). _
    Range(Cells( 5 ,  147 ).Address, Cells( 5 ,  158 ).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 4 ,  36 ).Address, Cells( 14 ,  36 ).Address)
  
  ' íîâàÿ ñòðàíè÷êà ______11
  Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("Ïðèõ³ä"). _
    Range(Cells( 5 ,  163 ).Address, Cells( 5 ,  164 ).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 4 ,  36 ).Address, Cells( 14 ,  36 ).Address)

'For n = 1 To ToRNG.Count
'ToRNG(n).Value = FromRNG(n).Value
'Next n

For n =  1  To ToRNG.Count
ToRNG(n).Value = FromRNG(n).Value
Next n


'Workbooks("01.xls").Close (False)
End Sub

Private Sub CommandButton1_Click()
Call Kyst1
End Sub

...

Рейтинг:

0 / 0

03.05.2007, 13:06:15

| Ответить | Цитировать | Написать

помогите разобраться, VBA

#34502054

Deggasad

Участник

Откуда: Воронеж

Сообщения: 3 509

Рейтинг: 0 / 0

Не самый лучший способ ты выбрал! Из тех что я предлагал!
Ну да ладно!
Вот так попробуй!

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.

Sub RegularCopy(ByVal y1 As Long, y2 As Long, y As Long)
Dim FromRNG As Range
Dim ToRNG As Range

Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("I?eo?a"). _
    Range(Cells( 5 , y1).Address, Cells( 5 , y2).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells( 4 , y).Address, Cells( 14 , y).Address)

 For n =  1  To ToRNG.Count
  ToRNG(n).Value = FromRNG(n).Value
 Next n
End Sub


Public Sub Kyst1()
FilePath = Workbooks("04_Zag_zvit.xls").Path + "\"
Workbooks.Open (FilePath + "kystu\04\01.xls")
 RegularCopy  3 ,  14 ,  36 
 RegularCopy  19 ,  30 ,  36 
 RegularCopy  35 ,  46 ,  36 
 RegularCopy  51 ,  62 ,  36 
 RegularCopy  67 ,  78 ,  36 
 RegularCopy  83 ,  94 ,  36 
 RegularCopy  99 ,  110 ,  36 
 RegularCopy  115 ,  126 ,  36 
 RegularCopy  131 ,  142 ,  36 
 RegularCopy  147 ,  158 ,  36 
 RegularCopy  163 ,  164 ,  36 
 
 
 Workbooks("01.xls").Close (False)
End Sub

Private Sub CommandButton1_Click()
Call Kyst1
End Sub

...

Рейтинг:

0 / 0

03.05.2007, 13:34:05

| Ответить | Цитировать | Написать

помогите разобраться, VBA

#34502901

maccen

Участник

Сообщения: 167

Рейтинг: 0 / 0

спасибо за ответ, а как быть если у меня разные ячейки:
заполняются данные с 4 по 14, далье с 15 по 26 (в 19, 30, 36).

огромное спасибо Deggasad
респетк всем, кто отвечает, дает дельные советы!

...

Рейтинг:

0 / 0

03.05.2007, 16:46:53

| Ответить | Цитировать | Написать

помогите разобраться, VBA

#34503003

Deggasad

Участник

Откуда: Воронеж

Сообщения: 3 509

Рейтинг: 0 / 0

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.

Sub RegularCopy(x As Long, ByVal y1 As Long, y2 As Long, x1 As Long, x2 As Long, y As Long)
Dim FromRNG As Range
Dim ToRNG As Range

Set ToRNG = Workbooks("04_Zag_zvit.xls").Worksheets("I?eo?a"). _
    Range(Cells(x, y1).Address, Cells(x, y2).Address)
Set FromRNG = Workbooks("01.xls").Worksheets("01"). _
  Range(Cells(x1, y).Address, Cells(x2, y).Address)

 For n =  1  To ToRNG.Count
  ToRNG(n).Value = FromRNG(n).Value
 Next n
End Sub


Public Sub Kyst1()
FilePath = Workbooks("04_Zag_zvit.xls").Path + "\"
Workbooks.Open (FilePath + "kystu\04\01.xls")
 RegularCopy  5 ,  3 ,  14 ,  4 ,  14 ,  36 
 RegularCopy  5 ,  19 ,  30 ,  4 ,  14 ,  36 
 RegularCopy  5 ,  35 ,  46 ,  4 ,  14 ,  36 
 RegularCopy  5 ,  51 ,  62 ,  4 ,  14 ,  36 
 RegularCopy  5 ,  67 ,  78 ,  4 ,  14 ,  36 
 RegularCopy  5 ,  83 ,  94 ,  4 ,  14 ,  36 
 RegularCopy  5 ,  99 ,  110 ,  4 ,  14 ,  36 
 RegularCopy  5 ,  115 ,  126 ,  4 ,  14 ,  36 
 RegularCopy  5 ,  131 ,  142 ,  4 ,  14 ,  36 
 RegularCopy  5 ,  147 ,  158 ,  4 ,  14 ,  36 
 RegularCopy  5 ,  163 ,  164 ,  4 ,  14 ,  36 
 
 
 Workbooks("01.xls").Close (False)
End Sub


Private Sub CommandButton1_Click()
Call Kyst1
End Sub

...

Рейтинг:

0 / 0

03.05.2007, 17:11:20

| Ответить | Цитировать | Написать

14 сообщений из 14, страница 1 из 1

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / помогите разобраться, VBA

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?fid=61&msg=34493660&tid=2183029]:	0ms
get settings:	9ms
get forum list:	15ms
check forum access:	2ms
check topic access:	2ms
track hit:	40ms
get topic data:	8ms
get forum data:	2ms
get page messages:	45ms
get tp. blocked users:	1ms
others:	206ms

total:	330ms

	Необходимые cookie
	Cookie для сбора статистики
	Cookie для маркетинга и рекламы