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

ReSQL.ru

2.0.61

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

Гость

Войти | Профиль | Очистить

Нов. | Гор. | Избр.

Написать

Автор*:

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

Тема*:

Сообщение

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

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

Автор:

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

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

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

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

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

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

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

Действия ...

Доб. в избранное
Игнор. тему
Прикреп. тему
Пометить прочит. / непрочит.
Фильтр:
Сообщения автора темы
Сообщение содержит вложения
Сообщение содержит картинки
Сообщение содержит видеоклипы
Сообщение содержит аудиоклипы
Сообщение содержит картинки или видео 18+

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

27.04.2007, 17:02:03

#34493642

maccen

Участник

Сообщения: 167
Рейтинг: 0 / 0

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

Как уменьшить код?
суть в том, есть файлик
файл 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:07:26

#34493660

vbapro

Участник

Сообщения: 1 112
Рейтинг: 0 / 0

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

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

...

Рейтинг:

0 / 0

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

27.04.2007, 17:19:13

#34493692

maccen

Участник

Сообщения: 167
Рейтинг: 0 / 0

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

Код: 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:25:10

#34493702

vbapro

Участник

Сообщения: 1 112
Рейтинг: 0 / 0

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

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

...

Рейтинг:

0 / 0

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

27.04.2007, 17:30:13

#34493714

maccen

Участник

Сообщения: 167
Рейтинг: 0 / 0

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

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

...

Рейтинг:

0 / 0

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

27.04.2007, 17:42:05

#34493749

vbapro

Участник

Сообщения: 1 112
Рейтинг: 0 / 0

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

...

Рейтинг:

0 / 0

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

27.04.2007, 17:56:02

#34493794

maccen

Участник

Сообщения: 167
Рейтинг: 0 / 0

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

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

...

Рейтинг:

0 / 0

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

27.04.2007, 18:53:23

#34493929

vbapro

Участник

Сообщения: 1 112
Рейтинг: 0 / 0

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

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

...

Рейтинг:

0 / 0

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

27.04.2007, 22:44:41

#34494176

Deggasad

Участник

Откуда: Воронеж
Сообщения: 3 509
Рейтинг: 0 / 0

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

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

Код: 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:54:42

#34494186

Deggasad

Участник

Откуда: Воронеж
Сообщения: 3 509
Рейтинг: 0 / 0

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

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

Код: 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

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

03.05.2007, 13:06:15

#34501914

maccen

Участник

Сообщения: 167
Рейтинг: 0 / 0

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

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

Код: 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:34:05

#34502054

Deggasad

Участник

Откуда: Воронеж
Сообщения: 3 509
Рейтинг: 0 / 0

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

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

Код: 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, 16:46:53

#34502901

maccen

Участник

Сообщения: 167
Рейтинг: 0 / 0

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

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

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

...

Рейтинг:

0 / 0

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

03.05.2007, 17:11:20

#34503003

Deggasad

Участник

Откуда: Воронеж
Сообщения: 3 509
Рейтинг: 0 / 0

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

Код: 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

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

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

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

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

start [/forum/topic.php?fid=61&tablet=1&tid=2183029]:	0ms
get settings:	6ms
get forum list:	10ms
check forum access:	2ms
check topic access:	2ms
track hit:	46ms
get topic data:	7ms
get forum data:	2ms
get page messages:	28ms
get tp. blocked users:	1ms
others:	197ms

total:	301ms

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